home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / magazi~1 / 334 / ultragr3.gfa (.txt) < prev    next >
Encoding:
GFA-BASIC Atari  |  1988-11-19  |  73.3 KB  |  3,582 lines
  1. ' +--------------------------------------------------------------+
  2. ' |                         Ultra-Graph                          |
  3. ' |                            v1.02                             |
  4. ' |                             by                               |
  5. ' |                   Phil Mast & Blake Arnold                   |
  6. ' +--------------------------------------------------------------+
  7. ' |                   GFA Basic 3.0 conversion                   |
  8. ' |                          11-19-88                            |
  9. ' +--------------------------------------------------------------+
  10. ' |    Featured in the November, 1988 issue of ST-Log Magazine   |
  11. ' +--------------------------------------------------------------+
  12. '
  13. GOSUB main
  14. PROCEDURE main
  15.   ' =========================-Initialize-==========================
  16.   CLS
  17.   IF FRE(0)<225000
  18.     ALERT 3,"Error: Not enough|free memory to run|Ultra-Graph.|(220K free required)",1,"Ok",dum%
  19.     ALERT 1,"|Current free memory   |is only "+STR$(CINT(FRE(0)/1024))+"K.      ",1,"Ok",dum%
  20.     EDIT
  21.   ENDIF
  22.   scrn|=0
  23.   p_file$="PM-1.00"
  24.   funct_error%=99999999
  25.   boot!=TRUE
  26.   kolor!=FALSE
  27.   off|=0
  28.   LET on|=1
  29.   lo|=0
  30.   med|=1
  31.   hi|=2
  32.   ' Store original color palette
  33.   DIM s_colr&(15,2)
  34.   FOR i%=0 TO 15
  35.     DPOKE CONTRL,26
  36.     DPOKE CONTRL+2,0
  37.     DPOKE CONTRL+6,2
  38.     DPOKE INTIN,i%
  39.     DPOKE INTIN+2,0
  40.     VDISYS
  41.     s_colr&(i%,0)=DPEEK(INTOUT+2)
  42.     s_colr&(i%,1)=DPEEK(INTOUT+4)
  43.     s_colr&(i%,2)=DPEEK(INTOUT+6)
  44.   NEXT i%
  45.   res|=XBIOS(4)  !Get the resolution
  46.   ' Allow more points to be plotted if more memory is present
  47.   IF FRE(0)>350000
  48.     max_pts|=99
  49.   ELSE
  50.     max_pts|=60
  51.   ENDIF
  52.   DIM px#(max_pts|,max_pts|),py#(max_pts|,max_pts|),pz#(max_pts|,max_pts|),type$(5),sav_colr%(1)
  53.   DIM pntint_x%(5),pntint_y%(5),minx#(5),miny#(5),maxx#(5),maxy#(5),cx%(5),cy%(5),z%(5),ex%(5),ey%(5),ez%(5)
  54.   DIM function$(5,20),equat%(5),max_limit#(5),min_limit#(5),colrtable|(15)
  55.   DIM n%(10),const#(5,10),paramx$(5),paramy$(5),paramz$(3),lintx%(5),linty%(5)
  56.   DIM rgb%(2),cfunctlabel$(5),postfix$(5),custom_funct!(5)
  57.   DIM numer_val#(30),priority%(100),stack#(30),stack_priority%(30),x%(4),y%(4)
  58.   DIM ed_surface#(max_pts|*max_pts|),pnt_no%(max_pts|*max_pts|)
  59.   IF res|=lo|
  60.     max_sx&=320 !Max & min values for different res's
  61.     max_sy&=200
  62.     ar#=6/7  ! Values to make circles look round in all resolutions
  63.     rxf|=1  !set scale factors for different resolutions
  64.     ryf|=1
  65.     rtxt|=13
  66.     rtxt1|=6
  67.     sclear|=34
  68.   ELSE IF res|=med|
  69.     max_sx&=640
  70.     max_sy&=200
  71.     ar#=2/5
  72.     rxf|=2
  73.     ryf|=1
  74.     rtxt|=13
  75.     rtxt1|=6
  76.     sclear|=68
  77.   ELSE IF res|=hi|
  78.     max_sx&=640
  79.     max_sy&=400
  80.     ar#=1
  81.     rxf|=2
  82.     ryf|=2
  83.     rtxt|=32
  84.     rtxt1|=13
  85.     sclear|=68
  86.   ENDIF
  87.   ' Menu data
  88.   ' --------
  89.   DIM d$(44)
  90.   d$(0)="Desk"
  91.   d$(1)=" About Ultra-Graph "
  92.   d$(2)="-------------------"
  93.   d$(3)="-"  ! "-" disables that menu item (disables ACC's here)
  94.   d$(4)="-"
  95.   d$(5)="-"
  96.   d$(6)="-"
  97.   d$(7)="-"
  98.   d$(8)="-"
  99.   d$(9)=""  !menus are seperated by a null
  100.   d$(10)="File"
  101.   d$(11)=" NeoChrome Save  "
  102.   d$(12)=" Degas Save      "
  103.   d$(13)=" Cad-3D Save     "
  104.   d$(14)="-----------------"
  105.   d$(15)=" Save Parameters "
  106.   d$(16)=" Load Parameters "
  107.   d$(17)="-----------------"
  108.   d$(18)="      Quit       "
  109.   d$(19)=""
  110.   d$(20)="Options"
  111.   d$(21)="  B/W Swap     "
  112.   d$(22)="  Gradient     "
  113.   d$(23)="  Rainbow      "
  114.   d$(24)="  Elevation    "
  115.   d$(25)="  Fill Pattern "
  116.   d$(26)="---------------"
  117.   d$(27)="  Grid Lines   "
  118.   d$(28)="  Hidden Lines "
  119.   d$(29)="  Draw Axes    "
  120.   d$(30)="  Auto-Center  "
  121.   d$(31)="  Auto-Scale   "
  122.   d$(32)="---------------"
  123.   d$(33)="  Graph it!    "
  124.   d$(34)="---------------"
  125.   d$(35)="  Demo Mode    "
  126.   d$(36)="  Defaults     "
  127.   d$(37)=""
  128.   d$(38)="System"
  129.   d$(39)="  Cartesian   "
  130.   d$(40)="  Polar       "
  131.   d$(41)="  Rectangular "
  132.   d$(42)="  Cylindrical "
  133.   d$(43)="  Spherical   "
  134.   d$(44)=""
  135.   type$(1)="Spherical"
  136.   type$(2)="Rectangular"
  137.   type$(3)="Cylindrical"
  138.   type$(4)="Cartesian"
  139.   type$(5)="Polar"
  140.   sphere|=1
  141.   rect|=2
  142.   cylin|=3
  143.   cart|=4
  144.   polar|=5
  145.   SGET screen1$
  146.   colrtable|(0)=0
  147.   colrtable|(1)=2
  148.   colrtable|(2)=3
  149.   colrtable|(3)=6
  150.   colrtable|(4)=4
  151.   colrtable|(5)=7
  152.   colrtable|(6)=5
  153.   colrtable|(7)=8
  154.   colrtable|(8)=9
  155.   colrtable|(9)=10
  156.   colrtable|(10)=11
  157.   colrtable|(11)=14
  158.   colrtable|(12)=12
  159.   colrtable|(13)=15
  160.   colrtable|(14)=13
  161.   colrtable|(15)=1
  162.   IF res|=med|
  163.     colrtable|(3)=1
  164.   ELSE IF res|=hi|
  165.     colrtable|(1)=1
  166.   ENDIF
  167.   ' x
  168.   paramx$(cart|)="X"
  169.   paramx$(polar|)="Θ"
  170.   paramx$(rect|)="X"
  171.   paramx$(sphere|)="ϕ"
  172.   paramx$(cylin|)="Θ"
  173.   ' y
  174.   paramy$(cart|)="Y"
  175.   paramy$(polar|)="R"
  176.   paramy$(rect|)="Y"
  177.   paramy$(sphere|)="Θ"
  178.   paramy$(cylin|)="Z"
  179.   ' z
  180.   paramz$(rect|)="Z"
  181.   paramz$(sphere|)="R"
  182.   paramz$(cylin|)="R"
  183.   '  ϕ=control-s+m  Θ=control-s+I
  184.   '  display functions (not used for calculations!)
  185.   ' CAPITAL letters are VARIABLES; DO NOT capitalize anything else!
  186.   '  Spherical
  187.   function$(sphere|,0)="r=A+B*sqr(C*cos(D*ϕ))"
  188.   function$(sphere|,1)="r=A+B*sin(C*ϕ/D)"
  189.   function$(sphere|,2)="r=A+B*sqr(C*ϕ)"
  190.   function$(sphere|,3)="r=A+B/cos(ϕ)"
  191.   function$(sphere|,4)="r=A+B*sin(C*Θ)"
  192.   function$(sphere|,5)="r=A*sin(B*ϕ)+C*cos(D*Θ)"
  193.   function$(sphere|,6)="r=A*sin(B*ϕ)/(C*cos(ϕ)+1)"
  194.   function$(sphere|,7)="r=A*sin(B*ϕ)+C*cos(D*ϕ)+E"
  195.   function$(sphere|,8)="r=A/(B-C*cos(D*(ϕ)))+E"
  196.   function$(sphere|,9)="r=A/(B-C*sin(D*(ϕ)))+E"
  197.   function$(sphere|,10)="r=A*sin(B*Θ)+C*cos(D*ϕ)"
  198.   function$(sphere|,11)="r=A*sin(exp(ϕ))+B*cos(exp(ϕ))"
  199.   function$(sphere|,12)="r=A*ϕ+B*Θ"
  200.   '  Rectangular
  201.   function$(rect|,0)="z=(A*x^2+B*y^2)*exp(1-C*x^2-D*y^2)"
  202.   function$(rect|,1)="z=A/sqr(B+x^2+y^2)*cos(sqr(C*y^2+D*x^2))"
  203.   function$(rect|,2)="z=(A*X*Y)^(1/B)"
  204.   function$(rect|,3)="z=A*sin(B*x)+C*cos(D*y)"
  205.   function$(rect|,4)="z=A*cos(B*x*C*y)"
  206.   function$(rect|,5)="z=A*(exp(B*sin(C*x*D*y)))"
  207.   function$(rect|,6)="z=A*(abs(B*cos(C*x)+D*cos(E*y)))"
  208.   function$(rect|,7)="z=A*(sqr(B*x^C+D*y^E))"
  209.   function$(rect|,8)="z=1/(A+x^2+y^2)-1/(B+x^2+(y-2)^2)"
  210.   function$(rect|,9)="z=(x^2*cos(A*x)+y^2*B*sin(C*y))*exp(1-x^2-y^2)"
  211.   function$(rect|,10)="z=A*log(abs(B*x))+C*log(abs(D*y))"
  212.   function$(rect|,11)="z=sin(A*x)*cos(B*y)"
  213.   function$(rect|,12)="z=A*cos(sqr(B*x^2+C*y^2))+D*cos(x)"
  214.   '  Cylindrical
  215.   function$(cylin|,0)="r=A+B*cos(C*Θ)+D*sin(E*Θ)"
  216.   function$(cylin|,1)="r=A/(B-C*cos(D*Θ))+E"
  217.   function$(cylin|,2)="r=A*sin(B*Θ)+C*cos(D*Θ)+E*z"
  218.   function$(cylin|,3)="r=A+B*sin(C*Θ)*cos(D*Θ)"
  219.   function$(cylin|,4)="r=A+B*tan(C*Θ)"
  220.   function$(cylin|,5)="r=A+B*sin(C*Θ)*(cos(D*Θ))^2"
  221.   function$(cylin|,6)="r=A+B*z-C*sin(D*z)"
  222.   function$(cylin|,7)="r=A*z^2+B*z+C"
  223.   function$(cylin|,8)="r=A/z^2+B/z+C"
  224.   function$(cylin|,9)="r=A+B*z+C*z*cos(D*Θ)"
  225.   function$(cylin|,10)="r=sin(A*z)*cos(B*Θ)"
  226.   '  Cartesian
  227.   function$(cart|,0)="y=A*x^3+B*x^2+C*x+D"
  228.   function$(cart|,1)="y=(A/sqr(2*Pi))*exp(-x^2/2)"
  229.   function$(cart|,2)="y=x/A+x^B-x^C"
  230.   function$(cart|,3)="y=A+B*sin(C*x)+D*x*(sin(E*x))"
  231.   function$(cart|,4)="y=A+B*cos(C*x)+D*x*(cos(E*x))"
  232.   function$(cart|,5)="y=A+B*tan(C*x)+D*x*(tan(E*x))"
  233.   function$(cart|,6)="y=A+B*1/cos(C*x)+D*x*1/cos(E*x)"
  234.   function$(cart|,7)="y=A+B*sin(C*x)+D*x*(cos(E*x))"
  235.   function$(cart|,8)="y=A+B*(exp(x)-exp(-x))/2+C*(exp(x)+exp(-x))/2"
  236.   function$(cart|,9)="y=A*sqr(B^2-x^2)"
  237.   function$(cart|,10)="y=(A*x-2)^3/(B*x^2)"
  238.   function$(cart|,11)="y=A*x^2/exp(B*x)"
  239.   function$(cart|,12)="y=cos(A*x)*exp(x/B)"
  240.   function$(cart|,13)="y=A*x^3*exp(-x/B)"
  241.   function$(cart|,14)="y=A*x/(B*x+C)^2"
  242.   function$(cart|,15)="y=A*atn(x)"
  243.   '  Polar
  244.   function$(polar|,0)="r=A+B*cos(C*Θ)+D*sin(E*Θ)"
  245.   function$(polar|,1)="r=A+B*sqr(C*cos(D*Θ))"
  246.   function$(polar|,2)="r=A/(B-C*cos(D*Θ))+E"
  247.   function$(polar|,3)="r=A/(B-C*sin(D*Θ))+E"
  248.   function$(polar|,4)="r=A+B*tan(C*Θ)"
  249.   function$(polar|,5)="r=A+B*sin(C*Θ)*tan(D*Θ)"
  250.   function$(polar|,6)="r=A/Θ"
  251.   function$(polar|,7)="r=A+B*sin(C*Θ)*cos(D*Θ)"
  252.   function$(polar|,8)="r=A+B/sin(C*Θ)"
  253.   function$(polar|,9)="r=A+B*sin(C*Θ)*(cos(D*Θ))^2"
  254.   ' ----------
  255.   GOSUB defaults
  256.   MENU d$()
  257.   MENU OFF
  258.   GOSUB mark_menu
  259.   ' Let the program know where to go on a drop-down selection
  260.   ON MENU GOSUB set_options
  261.   ' ----Main Loop for the option menu----
  262.   DO
  263.     ON MENU
  264.     dum%=MOUSEK
  265.     IF dum%=2
  266.       GOSUB screenswap
  267.     ELSE IF dum%=1 !  AND MENU(9)<>32 ! if menu(9)=32 then a drop-down is selected
  268.       GOSUB chg_params
  269.     ELSE IF dum%=3
  270.       GOSUB start
  271.       SGET screen1$
  272.     ENDIF
  273.   LOOP
  274. RETURN
  275. PROCEDURE set_options
  276.   ' OOOOOOOOOOOOOOOOOOOOOOOOOOO-Set Options-OOOOOOOOOOOOOOOOOOOOOOOOOOO
  277.   ' Drop-down menu selections
  278.   MENU OFF
  279.   IF d$(MENU(0))=d$(1)  ! About Ultra-Graph
  280.     GOSUB credits
  281.   ELSE IF d$(MENU(0))=d$(11)  ! Save Picture
  282.     IF graph!=TRUE
  283.       extender$=".NEO"
  284.       choice|=2
  285.       GOSUB open_file
  286.     ELSE
  287.       ALERT 3,"|No Graph to Save!",1,"Ok",dum%
  288.     ENDIF
  289.   ELSE IF d$(MENU(0))=d$(12)  ! Save Picture
  290.     IF graph!=TRUE
  291.       extender$=".PI"+STR$(res|+1)
  292.       choice|=1
  293.       GOSUB open_file
  294.     ELSE
  295.       ALERT 3,"|No Graph to Save!",1,"Ok",dum%
  296.     ENDIF
  297.   ELSE IF d$(MENU(0))=d$(13)  ! CAD-3D Save
  298.     IF graph!=TRUE
  299.       o_name$=STRING$(9,"_")
  300.       PRINT AT(6,22);"Object Name: ";
  301.       FORM INPUT 8,temp$
  302.       temp$=temp$+MKI$(0)
  303.       MID$(o_name$,1,LEN(temp$)-1)=temp$
  304.       POKE VARPTR(o_name$)+8,0
  305.       GOSUB clearit_all
  306.       PRINT AT(6,22);"Double Sided (Y/N)? ";
  307.       temp$=CHR$(INP(2))
  308.       IF UPPER$(temp$)="N"
  309.         dble!=FALSE
  310.       ELSE
  311.         dble!=TRUE
  312.       ENDIF
  313.       GOSUB clearit_all
  314.       IF NOT dble!
  315.         IF izhi%=pntint_x%(type|)
  316.           DEC izhi%
  317.         ENDIF
  318.         IF jzhi%=pntint_y%(type|)
  319.           DEC jzhi%
  320.         ENDIF
  321.         a1#=px#(izhi%+1,jzhi%+1)-px#(izhi%,jzhi%+1)
  322.         a2#=py#(izhi%+1,jzhi%+1)-py#(izhi%,jzhi%+1)
  323.         b1#=px#(izhi%,jzhi%+1)-px#(izhi%,jzhi%)
  324.         b2#=py#(izhi%,jzhi%+1)-py#(izhi%,jzhi%)
  325.         IF ABS(osurface1#)<1E-05
  326.           a1#=px#(izhi%,jzhi%)-px#(izhi%+1,jzhi%)
  327.           a2#=py#(izhi%,jzhi%)-py#(izhi%+1,jzhi%)
  328.           b1#=px#(izhi%+1,jzhi%)-px#(izhi%+1,jzhi%+1)
  329.           b2#=py#(izhi%+1,jzhi%)-py#(izhi%+1,jzhi%+1)
  330.         ENDIF
  331.         osurface#=a1#*b2#-a2#*b1#
  332.         IF SGN(osurface#)=-1
  333.           side1!=TRUE
  334.           side2!=FALSE
  335.         ELSE
  336.           side2!=TRUE
  337.           side1!=FALSE
  338.         ENDIF
  339.       ELSE
  340.         side1!=TRUE
  341.         side2!=TRUE
  342.       ENDIF
  343.       GOSUB clearit_all
  344.       extender$=".3D2"
  345.       choice|=4
  346.       GOSUB open_file
  347.     ELSE
  348.       ALERT 3,"|No object to save!",1,"Ok",dum%
  349.     ENDIF
  350.   ELSE IF d$(MENU(0))=d$(15)  ! Save Parameters
  351.     extender$=".PM"+STR$(res|+1)
  352.     choice|=3
  353.     GOSUB open_file
  354.   ELSE IF d$(MENU(0))=d$(16)  ! Load Parameters
  355.     choice|=5
  356.     extender$=".PM?"
  357.     GOSUB open_file
  358.     IF type|=cart| OR type|=polar|
  359.       GOSUB change_2d
  360.     ELSE
  361.       GOSUB change_3d
  362.     ENDIF
  363.     IF custom_funct!(type|)=TRUE
  364.       GOSUB convert
  365.     ENDIF
  366.     IF VAL(RIGHT$(filename$))<>res|+1
  367.       a_ctr|=on|
  368.       a_scl|=on|
  369.     ELSE
  370.       a_ctr|=off|
  371.       a_scl|=off|
  372.     ENDIF
  373.     GOSUB mark_menu
  374.   ELSE IF d$(MENU(0))=d$(18)  ! Quit
  375.     ALERT 2,"| Quit Ultra-Graph? ",1,"Yes|No ",dum%
  376.     IF dum%=1
  377.       CLS
  378.       ' Restore original color palette
  379.       FOR i%=0 TO 15
  380.         DPOKE CONTRL,14
  381.         DPOKE CONTRL+2,0
  382.         DPOKE CONTRL+6,4
  383.         DPOKE INTIN,i%
  384.         DPOKE INTIN+2,s_colr&(i%,0)
  385.         DPOKE INTIN+4,s_colr&(i%,1)
  386.         DPOKE INTIN+6,s_colr&(i%,2)
  387.         VDISYS
  388.       NEXT i%
  389.       MENU KILL
  390.       MENU OFF
  391.       EDIT
  392.     ENDIF
  393.   ELSE IF d$(MENU(0))=d$(21)  ! B/W Swap
  394.     IF palette|<>4
  395.       palette|=4 !White on black
  396.       IF res|=lo|
  397.         SETCOLOR 0,7,7,7
  398.         SETCOLOR 15,0,0,0
  399.       ELSE IF res|=hi|
  400.         SETCOLOR 0,0,0,0
  401.         SETCOLOR 1,7,7,7
  402.       ELSE IF res|=med|
  403.         SETCOLOR 0,7,7,7
  404.         SETCOLOR 3,0,0,0
  405.       ENDIF
  406.     ELSE
  407.       palette|=0 !Black on white (normal screen)
  408.       IF res|=lo|
  409.         SETCOLOR 15,7,7,7
  410.         SETCOLOR 0,0,0,0
  411.       ELSE IF res|=hi|
  412.         SETCOLOR 0,7,7,7
  413.         SETCOLOR 1,0,0,0
  414.       ELSE IF res|=med|
  415.         SETCOLOR 0,0,0,0
  416.         SETCOLOR 3,7,7,7
  417.       ENDIF
  418.     ENDIF
  419.     GOSUB mark_menu
  420.   ELSE IF d$(MENU(0))=d$(22)  ! Gradient
  421.     ALERT 2,"|  Which Color?  ",1,"R|G|B",palette|
  422.     GOSUB palette
  423.   ELSE IF d$(MENU(0))=d$(23) ! Rainbow
  424.     palette|=5
  425.     GOSUB palette
  426.   ELSE IF d$(MENU(0))=d$(24) ! Elevation
  427.     palette|=6
  428.     GOSUB palette
  429.   ELSE IF d$(MENU(0))=d$(25)  ! Fill Pattern
  430.     GOSUB get_pattern
  431.   ELSE IF d$(MENU(0))=d$(27)  ! Grid Lines
  432.     IF grid_lines|=off|
  433.       grid_lines|=on|
  434.       axes|=off|
  435.     ELSE
  436.       grid_lines|=off|
  437.     ENDIF
  438.     GOSUB mark_menu
  439.   ELSE IF d$(MENU(0))=d$(28)  ! Hidden Lines
  440.     IF hide_lines|=off|
  441.       hide_lines|=on|
  442.     ELSE
  443.       hide_lines|=off|
  444.     ENDIF
  445.     GOSUB mark_menu
  446.     GOSUB lint
  447.   ELSE IF d$(MENU(0))=d$(29)  ! Draw Axes
  448.     IF axes|=off|
  449.       axes|=on|
  450.       grid_lines|=off|
  451.     ELSE
  452.       axes|=off|
  453.     ENDIF
  454.     GOSUB mark_menu
  455.   ELSE IF d$(MENU(0))=d$(30)  ! Auto Center
  456.     IF a_ctr|=on|
  457.       a_ctr|=off|
  458.     ELSE
  459.       a_ctr|=on|
  460.     ENDIF
  461.     GOSUB mark_menu
  462.   ELSE IF d$(MENU(0))=d$(31)  ! Auto Scale
  463.     IF a_scl|=on|
  464.       a_scl|=off|
  465.     ELSE
  466.       a_scl|=on|
  467.     ENDIF
  468.     GOSUB mark_menu
  469.   ELSE IF d$(MENU(0))=d$(33)  ! Graph it
  470.     GOSUB start
  471.     SGET screen1$
  472.   ELSE IF d$(MENU(0))=d$(35)  ! Demo Mode
  473.     ALERT 1," | To exit Demo Mode,| push ESCAPE after | a graph is drawn. ",1," Demo |Cancel",dum%
  474.     IF dum%=1
  475.       GOSUB do_demo
  476.     ENDIF
  477.   ELSE IF d$(MENU(0))=d$(36)  ! Defaults
  478.     ALERT 2,"| Restore Defaults? ",2,"Yes|No",dum%
  479.     IF dum%=1
  480.       ERASE px#()
  481.       ERASE py#()
  482.       ERASE pz#()
  483.       DIM px#(max_pts|,max_pts|),py#(max_pts|,max_pts|),pz#(max_pts|,max_pts|)
  484.       CLS
  485.       GOSUB defaults
  486.       GOSUB mark_menu
  487.     ENDIF
  488.   ELSE IF d$(MENU(0))=d$(39)  ! Cartesian
  489.     type|=cart|
  490.     GOSUB change_2d
  491.   ELSE IF d$(MENU(0))=d$(40)  ! Polar
  492.     type|=polar|
  493.     GOSUB change_2d
  494.   ELSE IF d$(MENU(0))=d$(41)  ! Rectangular
  495.     type|=rect|
  496.     GOSUB change_3d
  497.   ELSE IF d$(MENU(0))=d$(42)  ! Cylindrical
  498.     type|=cylin|
  499.     GOSUB change_3d
  500.   ELSE IF d$(MENU(0))=d$(43)  ! Spherical
  501.     type|=sphere|
  502.     GOSUB change_3d
  503.   ENDIF
  504. RETURN
  505. PROCEDURE change_2d
  506.   ' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^-2D/3D-^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  507.   MENU KILL
  508.   three_d!=FALSE
  509.   cf!=TRUE
  510.   axes|=off|
  511.   kolor!=FALSE
  512.   ERASE px#()
  513.   ERASE py#()
  514.   ERASE pz#()
  515.   DIM px#(0,999),py#(0,999),pz#(0,999)
  516.   GOSUB mark_menu
  517.   GOSUB palette
  518.   GOSUB getconst
  519.   IF demo|=on|
  520.     title!=TRUE
  521.   ELSE
  522.     title!=FALSE
  523.   ENDIF
  524.   GOSUB param_menu
  525.   title!=TRUE
  526. RETURN
  527. PROCEDURE change_3d
  528.   MENU KILL
  529.   three_d!=TRUE
  530.   cf!=TRUE
  531.   ERASE px#()
  532.   ERASE py#()
  533.   ERASE pz#()
  534.   DIM px#(max_pts|,max_pts|),py#(max_pts|,max_pts|),pz#(max_pts|,max_pts|)
  535.   GOSUB palette
  536.   GOSUB getconst
  537.   IF demo|=on|
  538.     title!=TRUE
  539.   ELSE
  540.     title!=FALSE
  541.   ENDIF
  542.   GOSUB param_menu
  543.   title!=TRUE
  544. RETURN
  545. PROCEDURE mark_menu
  546.   ' %%%%%%%%%%%%%%%%%%%-Set Menu Checks (markit)-%%%%%%%%%%%%%%%%%%%%
  547.   ' set the check-marks on the drop-downs
  548.   IF NOT three_d!
  549.     MENU 13,2
  550.     MENU 22,2
  551.     MENU 23,2
  552.     MENU 24,2
  553.     MENU 25,2
  554.     MENU 27,3
  555.     MENU 28,2
  556.     MENU 29,3
  557.     IF grid_lines|=on|
  558.       MENU 29,2
  559.     ENDIF
  560.     IF axes|=on|
  561.       MENU 27,2
  562.     ENDIF
  563.   ELSE
  564.     MENU 13,3
  565.     MENU 22,3
  566.     MENU 23,3
  567.     MENU 24,3
  568.     MENU 25,3
  569.     MENU 27,2
  570.     MENU 28,3
  571.   ENDIF
  572.   IF res|=lo|
  573.     IF palette|=0 OR palette|=4
  574.       MENU 21,1  ! 1 puts a check by the menu item
  575.       MENU 22,0  ! 0 removes a check
  576.       MENU 23,0
  577.       MENU 24,0
  578.     ELSE IF palette|=1 OR palette|=2 OR palette|=3
  579.       MENU 21,0
  580.       MENU 22,1
  581.       MENU 23,0
  582.       MENU 24,0
  583.     ELSE IF palette|=5
  584.       MENU 21,0
  585.       MENU 22,0
  586.       MENU 23,1
  587.       MENU 24,0
  588.     ELSE IF palette|=6
  589.       MENU 21,0
  590.       MENU 22,0
  591.       MENU 23,0
  592.       MENU 24,1
  593.     ENDIF
  594.   ELSE
  595.     MENU 11,2  !Void NeoChrome save
  596.     MENU 22,2  !Void Color Palettes
  597.     MENU 23,2
  598.     MENU 24,2
  599.   ENDIF
  600.   IF type|=4
  601.     MENU 39,1
  602.     MENU 40,0
  603.     MENU 41,0
  604.     MENU 42,0
  605.     MENU 43,0
  606.   ELSE IF type|=5
  607.     MENU 39,0
  608.     MENU 40,1
  609.     MENU 41,0
  610.     MENU 42,0
  611.     MENU 43,0
  612.   ELSE IF type|=2
  613.     MENU 39,0
  614.     MENU 40,0
  615.     MENU 41,1
  616.     MENU 42,0
  617.     MENU 43,0
  618.   ELSE IF type|=3
  619.     MENU 39,0
  620.     MENU 40,0
  621.     MENU 41,0
  622.     MENU 42,1
  623.     MENU 43,0
  624.   ELSE IF type|=1
  625.     MENU 39,0
  626.     MENU 40,0
  627.     MENU 41,0
  628.     MENU 42,0
  629.     MENU 43,1
  630.   ENDIF
  631.   MENU 27,grid_lines|
  632.   MENU 28,hide_lines|
  633.   MENU 29,axes|   !since these values can only be 0 or 1 we can get away
  634.   MENU 30,a_ctr|  !with this
  635.   MENU 31,a_scl|
  636. RETURN
  637. PROCEDURE credits
  638.   ' ********************** - Credits box - ***********************
  639.   CLS
  640.   IF res|=lo|
  641.     pfx&=0
  642.     pfy&=0
  643.   ELSE IF res|=med|
  644.     pfx&=160
  645.     pfy&=0
  646.   ELSE IF res|=hi|
  647.     pfx&=160
  648.     pfy&=90
  649.   ENDIF
  650.   ~FORM_DIAL(1,0,0,0,0,9+pfx&,10+pfy&,311,191)
  651.   ' Fake a huge ALERT box so we can squeeze in all the credits.
  652.   COLOR colrtable|(1)
  653.   DEFLINE 1,1
  654.   ' "Defline 1,2" doesn't seem to work (the line ends up 3 pixels wide), so we
  655.   ' fake that, too
  656.   ' main box
  657.   BOX 9+pfx&,9+pfy&,311+pfx&,191+pfy&
  658.   BOX 10+pfx&,10+pfy&,310+pfx&,190+pfy&
  659.   DEFLINE 1,1
  660.   BOX 13+pfx&,13+pfy&,306+pfx&,187+pfy&
  661.   ' text
  662.   DEFTEXT 3,9,0,19
  663.   TEXT 94+pfx&,35+pfy&,"Ultra-Graph"
  664.   DEFTEXT 1,0,0,4
  665.   TEXT 137+pfx&,70+pfy&,"and"
  666.   TEXT 118+pfx&,45+pfy&,"Copyright 1988"
  667.   '  TEXT 85+pfx&,99+pfy&,"(Available from MichTron)"
  668.   DEFTEXT 1,0,0,6
  669.   TEXT 150+pfx&,57+pfy&,"By"
  670.   TEXT 66+pfx&,90+pfy&,"Programmed in"
  671.   TEXT 100+pfx&,120+pfy&,"Available from:"
  672.   TEXT 38+pfx&,152+pfy&,"9171 Wilshire Blvd., Suite 300"
  673.   TEXT 68+pfx&,163+pfy&,"Beverly Hills, CA 90210"
  674.   DEFTEXT 3,1,0,7
  675.   TEXT 41+pfx&,70+pfy&,"Phil Mast"
  676.   TEXT 166+pfx&,70+pfy&,"Blake Arnold"
  677.   DEFTEXT 1,1,0,6
  678.   TEXT 179+pfx&,90+pfy&,"GFA Basic"
  679.   DEFTEXT 3,4,0,15
  680.   TEXT 95+pfx&,140+pfy&,"ST-Log"
  681.   DEFTEXT 3,4,0,6
  682.   TEXT 161+pfx&,140+pfy&,"Magazine"
  683.   DEFTEXT 2,0,0,4
  684.   TEXT 274+pfx&,184+pfy&,"v1.02"
  685.   ' are we having fun yet?
  686.   IF boot!=FALSE
  687.     DEFLINE 1,1,0,0
  688.     BOX 134+pfx&,169+pfy&,182+pfx&,181+pfy&
  689.     BOX 133+pfx&,168+pfy&,183+pfx&,182+pfy&
  690.     DEFTEXT 1,0,0,6
  691.     TEXT 150+pfx&,178+pfy&,"Ok"
  692.     DO
  693.       MOUSE micex&,micey&,dum%
  694.       IF (micey&>168+pfy& AND micey&<182+pfy&) AND (micex&>133+pfx& AND micex&<183+pfx&) AND dum%=1
  695.         GOTO done_box
  696.       ENDIF
  697.       EXIT IF INKEY$=CHR$(13)
  698.     LOOP
  699.   done_box:
  700.     ' To complete the illusion of an ALERT box, we even fill the "Ok" box as
  701.     ' GEM would do.
  702.     DEFFILL 2,2,8
  703.     PBOX 133+pfx&,168+pfy&,183+pfx&,182+pfy&
  704.     IF res|=lo| OR res|=med|
  705.       DEFTEXT 1,0,0,6
  706.     ELSE
  707.       DEFTEXT 1,0,0,13
  708.     ENDIF
  709.     CLS
  710.     title!=TRUE
  711.     ~FORM_DIAL(2,0,0,0,0,9+pfx&,10+pfy&,311,191)
  712.     GOSUB param_menu !Reprint the menu screen
  713.     PAUSE 30
  714.   ELSE
  715.     PAUSE 150
  716.     CLS
  717.     ~FORM_DIAL(2,0,0,0,0,9+pfx&,10+pfy&,311,191)
  718.   ENDIF
  719.   title!=TRUE
  720. RETURN
  721. PROCEDURE do_demo
  722.   ' dddddddddddddddddddddddddddddd- DEMO -dddddddddddddddddddddddddddd
  723.   dum%=1
  724.   ' Next rem should be active as a statement in compiled (2.02) version only
  725.   '  Alert 2,"|Demo exits to bombs.|   Continue?    ",1,"Yes| No",Dum%
  726.   IF dum%<>2
  727.     demo|=on|
  728.     GOSUB defaults
  729.     DEFMOUSE 2
  730.     REPEAT
  731.       jj%=0
  732.       REPEAT
  733.         type|=sphere|
  734.         REPEAT
  735.           CLS
  736.           equat%(type|)=jj%
  737.           IF type|=cart| OR type|=polar|
  738.             GOSUB change_2d
  739.           ELSE
  740.             GOSUB change_3d
  741.           ENDIF
  742.           PAUSE 100
  743.           cf!=TRUE
  744.           GOSUB start
  745.           SGET screen1$
  746.           FOR i%=1 TO 200
  747.             PAUSE 1
  748.             temp$=INKEY$
  749.             EXIT IF temp$=CHR$(27)
  750.           NEXT i%
  751.           INC type|
  752.         UNTIL type|=6 OR temp$=CHR$(27)
  753.         type|=1
  754.         INC jj%
  755.       UNTIL jj%=10 OR temp$=CHR$(27)
  756.     UNTIL temp$=CHR$(27)
  757.     CLS
  758.     demo|=off|
  759.     GOSUB defaults
  760.     DEFMOUSE 0
  761.     SHOWM
  762.   ENDIF
  763. RETURN
  764. PROCEDURE defaults
  765.   ' ###########################-Defaults-############################
  766.   VOID FRE(0)
  767.   three_d!=TRUE
  768.   ptrn|=8
  769.   trig!=FALSE
  770.   title!=TRUE
  771.   graph!=FALSE
  772.   ' Axes OFF, Auto-center ON, Auto-Scale ON, Hidden Lines ON, Grid Lines ON
  773.   grid_lines|=on|
  774.   hide_lines|=on|
  775.   axes|=off|
  776.   a_ctr|=on|
  777.   a_scl|=on|
  778.   cf!=TRUE  !Function change flag
  779.   IF res|=lo|
  780.     SETCOLOR 0,0,0,0
  781.     SETCOLOR 15,7,7,7
  782.   ELSE IF res|=hi|
  783.     SETCOLOR 0,7,7,7
  784.     SETCOLOR 1,0,0,0
  785.   ELSE IF res|=med|
  786.     SETCOLOR 3,7,7,7
  787.     SETCOLOR 0,0,0,0
  788.   ENDIF
  789.   IF res|<>hi|
  790.     FOR i%=1 TO 5
  791.       z%(i%)=80
  792.     NEXT i%
  793.     palette|=5
  794.     GOSUB palette
  795.   ELSE
  796.     FOR i%=1 TO 5
  797.       z%(i%)=120
  798.     NEXT i%
  799.   ENDIF
  800.   FOR i%=1 TO 5
  801.     cx%(i%)=max_sx&/2
  802.     cy%(i%)=max_sy&/2
  803.     custom_funct!(i%)=FALSE
  804.   NEXT i%
  805.   ' set initial constant values to 1 for all functions
  806.   FOR i%=1 TO 5
  807.     FOR j%=1 TO 10
  808.       const#(i%,j%)=1
  809.     NEXT j%
  810.   NEXT i%
  811.   minx#(rect|)=-3
  812.   maxx#(rect|)=3
  813.   miny#(rect|)=-3
  814.   maxy#(rect|)=3
  815.   minx#(sphere|)=PI
  816.   maxx#(sphere|)=2*PI
  817.   miny#(sphere|)=0
  818.   maxy#(sphere|)=2*PI
  819.   minx#(cylin|)=0
  820.   maxx#(cylin|)=2*PI
  821.   miny#(cylin|)=0
  822.   maxy#(cylin|)=3
  823.   minx#(cart|)=-3.14
  824.   maxx#(cart|)=3.14
  825.   FOR i%=1 TO 5
  826.     max_limit#(i%)=4
  827.     min_limit#(i%)=-4
  828.     lintx%(i%)=1
  829.     linty%(i%)=1
  830.     pntint_x%(i%)=25
  831.     pntint_y%(i%)=25
  832.     ex%(i%)=20
  833.     ey%(i%)=25
  834.     ez%(i%)=15
  835.   NEXT i%
  836.   pntint_x%(cart|)=0
  837.   pntint_y%(cart|)=max_sx&-20
  838.   x_int#=0.5
  839.   y_int#=0.5
  840.   ex%(cart|)=9999
  841.   ey%(cart|)=0
  842.   ez%(cart|)=0
  843.   minx#(polar|)=0
  844.   maxx#(polar|)=2*PI
  845.   pntint_x%(polar|)=0
  846.   pntint_y%(polar|)=max_sx&-20
  847.   ex%(polar|)=9999
  848.   ey%(polar|)=0
  849.   ez%(polar|)=0
  850.   type|=rect|    !intial type
  851.   GOSUB getconst !get everything fired up and ready to go (sets variables)
  852.   IF boot!=TRUE
  853.     SETCOLOR 1,0,0,6
  854.     SETCOLOR 2,0,7,1
  855.     COLOR colrtable|(1)
  856.     HIDEM
  857.     GOSUB credits
  858.     SHOWM
  859.     CLS
  860.     ' Draw and save main menu border
  861.     DEFLINE 1,4,0,0
  862.     DEFFILL colrtable|(2),2,8
  863.     COLOR colrtable|(1)
  864.     BOX 5*rxf|,19*ryf|,316*rxf|,195*ryf|
  865.     IF res|=lo|
  866.       DRAW 3*rxf|,19*ryf| TO 4*rxf|,19*ryf|
  867.     ELSE
  868.       DRAW 4*rxf|,19*ryf| TO 5*rxf|,19*ryf|
  869.     ENDIF
  870.     DEFLINE 1,1,0,0
  871.     BOX 11*rxf|,23*ryf|,310*rxf|,191*ryf|
  872.     IF res|<>hi|
  873.       FILL 160*rxf|,21*ryf|
  874.     ENDIF
  875.     DEFLINE 1,1,0,0
  876.     BOX 15*rxf|,162*ryf|,306*rxf|,187*ryf|
  877.     LINE 11*rxf|,158*ryf|,310*rxf|,158*ryf|
  878.     DEFTEXT colrtable|(2),16,0,rtxt|
  879.     IF res|<>1
  880.       TEXT 100*rxf|,26*ryf|,"Ultra-Graph"
  881.       DEFTEXT 1,0,0,rtxt1|
  882.     ELSE
  883.       TEXT 260,26,"Ultra-Graph"
  884.     ENDIF
  885.     IF res|<>hi|
  886.       DEFFILL colrtable|(1),2,8
  887.     ELSE
  888.       DEFFILL colrtable|(0),2,8
  889.     ENDIF
  890.     COLOR colrtable|(15)
  891.     PBOX 25*rxf|,47*ryf|,31*rxf|,53*ryf|
  892.     BOX 25*rxf|,47*ryf|,31*rxf|,53*ryf|
  893.     PBOX 25*rxf|,65*ryf|,31*rxf|,71*ryf|
  894.     BOX 25*rxf|,65*ryf|,31*rxf|,71*ryf|
  895.     PBOX 25*rxf|,75*ryf|,31*rxf|,81*ryf|
  896.     BOX 25*rxf|,75*ryf|,31*rxf|,81*ryf|
  897.     PBOX 25*rxf|,93*ryf|,31*rxf|,99*ryf|
  898.     BOX 25*rxf|,93*ryf|,31*rxf|,99*ryf|
  899.     PBOX 25*rxf|,103*ryf|,31*rxf|,109*ryf|
  900.     BOX 25*rxf|,103*ryf|,31*rxf|,109*ryf|
  901.     PBOX 25*rxf|,113*ryf|,31*rxf|,119*ryf|
  902.     BOX 25*rxf|,113*ryf|,31*rxf|,119*ryf|
  903.     PBOX 25*rxf|,123*ryf|,31*rxf|,129*ryf|
  904.     BOX 25*rxf|,123*ryf|,31*rxf|,129*ryf|
  905.     PBOX 25*rxf|,133*ryf|,31*rxf|,139*ryf|
  906.     BOX 25*rxf|,133*ryf|,31*rxf|,139*ryf|
  907.     PBOX 25*rxf|,143*ryf|,31*rxf|,149*ryf|
  908.     BOX 25*rxf|,143*ryf|,31*rxf|,149*ryf|
  909.     SGET mscreen$
  910.   ENDIF
  911.   boot!=FALSE
  912.   GOSUB param_menu
  913. RETURN
  914. PROCEDURE palette
  915.   ' ++++++++++++++++++++++++++++-Palette-++++++++++++++++++++++++++++
  916.   IF res|=lo|
  917.     IF palette|<>4
  918.       IF palette|=1
  919.         RESTORE red
  920.       ELSE IF palette|=2
  921.         RESTORE green
  922.       ELSE IF palette|=3
  923.         RESTORE blue
  924.       ELSE IF palette|=5
  925.         RESTORE rainbow
  926.       ELSE
  927.         RESTORE elevation
  928.       ENDIF
  929.       IF three_d!=FALSE
  930.         RESTORE twod
  931.       ENDIF
  932.       FOR i%=0 TO 15
  933.         READ colr%
  934.         IF i%=1 OR i%=2
  935.           sav_colr%(i%-1)=colr%
  936.         ELSE
  937.           SETCOLOR i%,colr%
  938.         ENDIF
  939.       NEXT i%
  940.     ENDIF
  941.   rainbow:
  942.     DATA &000,&700,&730,&751,&770,&561,&360,&051,&054,&045,&226,&305,&404,&514,&716,&777
  943.   elevation:
  944.     DATA &000,&776,&775,&764,&653,&553,&453,&243,&244,&345,&246,&236,&125,&115,&004,&777
  945.   red:
  946.     DATA &000,&755,&744,&733,&722,&711,&711,&700,&600,&600,&500,&400,&400,&300,&300,&777
  947.   green:
  948.     DATA &000,&575,&474,&373,&272,&171,&070,&060,&060,&050,&040,&040,&030,&030,&020,&777
  949.   blue:
  950.     DATA &000,&557,&447,&337,&227,&117,&117,&007,&006,&006,&005,&004,&004,&003,&003,&777
  951.   twod:
  952.     DATA &000,&750,&400,&047,&555,&117,&117,&007,&006,&006,&005,&004,&004,&003,&003,&777
  953.   ELSE IF res|=med|
  954.     sav_colr%(0)=&H750
  955.     sav_colr%(1)=&H400
  956.   ENDIF
  957.   GOSUB mark_menu
  958. RETURN
  959. PROCEDURE start
  960.   ' SSSSSSSSSSSSSSSSSSSSSSSSSSSS-Start-SSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
  961.   VOID FRE(0)
  962.   HIDEM
  963.   graph!=TRUE
  964.   MENU KILL
  965.   MENU OFF
  966.   CLS
  967.   GOSUB graphit
  968.   GOSUB hide_mouse
  969. RETURN
  970. PROCEDURE hide_mouse
  971.   ' ---------- Keep the mouse arrow hidden and look for right mouse button-------
  972.   HIDEM
  973.   PAUSE 30
  974.   IF demo|=off|
  975.     DO
  976.       EXIT IF MOUSEK=2
  977.     LOOP
  978.     SHOWM
  979.   ENDIF
  980. RETURN
  981. PROCEDURE autocenter
  982.   ' AAAAAAAAAAAAAAAAAAAAAAAAAA-Autocenter-AAAAAAAAAAAAAAAAAAAAAAAAAA
  983.   ON ERROR GOSUB graph_error1
  984.   qx#=px#(ixhi%,jxhi%)
  985.   qy#=py#(ixhi%,jxhi%)
  986.   qz#=pz#(ixhi%,jxhi%)
  987.   GOSUB calcsxsy
  988.   sxhi#=sx#
  989.   qx#=px#(ixlo%,jxlo%)
  990.   qy#=py#(ixlo%,jxlo%)
  991.   qz#=pz#(ixlo%,jxlo%)
  992.   GOSUB calcsxsy
  993.   sxlo#=sx#
  994.   qx#=px#(iyhi%,jyhi%)
  995.   qy#=py#(iyhi%,jyhi%)
  996.   qz#=pz#(iyhi%,jyhi%)
  997.   GOSUB calcsxsy
  998.   syhi#=sy#
  999.   qx#=px#(iylo%,jylo%)
  1000.   qy#=py#(iylo%,jylo%)
  1001.   qz#=pz#(iylo%,jylo%)
  1002.   GOSUB calcsxsy
  1003.   sylo#=sy#
  1004.   cx%(type|)=INT(cx%(type|)+max_sx&/2-(sxhi#+sxlo#)/2)
  1005.   cy%(type|)=INT(cy%(type|)+(max_sy&/2-(syhi#+sylo#)/2)*1/ar#)
  1006.   ON ERROR
  1007. auto_cen1:
  1008. RETURN
  1009. PROCEDURE graph_error1
  1010.   graph!=FALSE
  1011.   PRINT "◆"
  1012.   ALERT 1,"|Graph lies outside |the specified range",1,"Oops",dum%
  1013.   RESUME auto_cen1
  1014. RETURN
  1015. PROCEDURE autoscale
  1016.   ' *************************-Autoscale-***************************
  1017.   IF three_d!
  1018.     xratio#=(sxhi#-sxlo#)/(max_sx&-20*rxf|)
  1019.     yratio#=(syhi#-sylo#)/(max_sy&-20*ryf|)
  1020.   ELSE
  1021.     xratio#=(sxhi#-sxlo#)/(max_sx&-50*rxf|)
  1022.     yratio#=(syhi#-sylo#)/(max_sy&-50*ryf|)
  1023.   ENDIF
  1024.   ON ERROR GOSUB graph_error
  1025.   dum_z#=z%(type|)
  1026.   IF xratio#>yratio#
  1027.     DIV dum_z#,xratio#
  1028.   ELSE
  1029.     DIV dum_z#,yratio#
  1030.   ENDIF
  1031.   z%(type|)=dum_z#
  1032.   IF z%(type|)=0
  1033.     z%(type|)=1
  1034.   ENDIF
  1035.   ON ERROR
  1036. autoscl1:
  1037. RETURN
  1038. PROCEDURE graph_error
  1039.   PRINT "◆"
  1040.   ALERT 1,"|Graph lies outside |the specified range",1,"Oops",dum%
  1041.   graph!=FALSE
  1042.   RESUME autoscl1
  1043. RETURN
  1044. PROCEDURE calcsxsy
  1045.   ' FFFFFFFFFFFFFFFFFFFFFFFFF-Calculate Sx,Sy-FFFFFFFFFFFFFFFFFFFFFF
  1046.   ' Calculate the screen coordinates of each point
  1047.   SUB qx#,fx#
  1048.   SUB qy#,fy#
  1049.   SUB qz#,fz#
  1050.   ' Project the vectors onto the screen plane
  1051.   sx#=qx#*m1#+qy#*m2#+qz#*m3#
  1052.   sy#=qx#*m4#+qy#*m5#+qz#*m6#
  1053.   sz#=qx#*m7#+qy#*m8#+qz#*m9#
  1054.   x#=ed#-sz#
  1055.   IF x#<1
  1056.     x#=1
  1057.   ENDIF
  1058.   ADD x#,x#
  1059.   t#=(z%(type|)*ed#)/x#
  1060.   sx#=t#*sx#+cx%(type|)
  1061.   sy#=cy%(type|)-t#*sy#
  1062.   MUL sy#,ar#
  1063. RETURN
  1064. PROCEDURE calcsxsyhilo
  1065.   ' //////////////////////-Calculate sx sy Hi/Lo-////////////////////
  1066.   ' Find the hi & lo values of screen coordinates for autocenter
  1067.   firstpass%=1
  1068.   FOR i%=0 TO pntint_x%(type|) STEP 2
  1069.     FOR j%=0 TO pntint_y%(type|) STEP 2
  1070.       qx#=px#(i%,j%)
  1071.       qy#=py#(i%,j%)
  1072.       qz#=pz#(i%,j%)
  1073.       IF pz#(i%,j%)<>funct_error%
  1074.         GOSUB calcsxsy
  1075.         IF firstpass%=1 !If this is the first time through set initial values
  1076.           sxhi#=sx#
  1077.           ixhi%=i%
  1078.           jxhi%=j%
  1079.           sxlo#=sx#
  1080.           ixlo%=i%
  1081.           jxlo%=j%
  1082.           syhi#=sy#
  1083.           iyhi%=i%
  1084.           jyhi%=j%
  1085.           sylo#=sy#
  1086.           iylo%=i%
  1087.           jylo%=j%
  1088.           firstpass%=2
  1089.         ENDIF
  1090.         IF sx#>sxhi#
  1091.           sxhi#=sx#
  1092.           ixhi%=i%
  1093.           jxhi%=j%
  1094.         ENDIF
  1095.         IF sx#<sxlo#
  1096.           sxlo#=sx#
  1097.           ixlo%=i%
  1098.           jxlo%=j%
  1099.         ENDIF
  1100.         IF sy#>syhi#
  1101.           syhi#=sy#
  1102.           iyhi%=i%
  1103.           jyhi%=j%
  1104.         ENDIF
  1105.         IF sy#<sylo#
  1106.           sylo#=sy#
  1107.           iylo%=i%
  1108.           jylo%=j%
  1109.         ENDIF
  1110.       ENDIF
  1111.     NEXT j%
  1112.   NEXT i%
  1113. RETURN
  1114. PROCEDURE graphit
  1115.   ' GGGGGGGGGGGGGGGGGGGGGGGGGG-Graph It-GGGGGGGGGGGGGGGGGGGGGGGGGGG
  1116.   PRINT CHR$(10)
  1117.   IF res|<>hi|
  1118.     SETCOLOR 1,sav_colr%(0)
  1119.     SETCOLOR 2,sav_colr%(1)
  1120.   ENDIF
  1121.   IF res|=lo|
  1122.     IF palette|<>0 AND palette|<>4 AND three_d!=TRUE
  1123.       kolor!=TRUE
  1124.     ELSE
  1125.       kolor!=FALSE
  1126.     ENDIF
  1127.   ENDIF
  1128.   IF cf!=TRUE !If we haven't changed functions don't need to recalculate points
  1129.     IF pntint_x%(type|)<>0
  1130.       calc_points%=(pntint_x%(type|)+1)*(pntint_y%(type|)+1)
  1131.     ELSE
  1132.       calc_points%=pntint_y%(type|)+1
  1133.     ENDIF
  1134.     PRINT ''"Calculating ";calc_points%;" Points"
  1135.     PRINT AT(3,4);"Points Remaining:"
  1136.     ON type| GOSUB spheric,rect,cylin,cart,polar
  1137.     ' compute color band interval size
  1138.     dz1#=(zhi#-zlo#)/14
  1139.     IF dz1#=0
  1140.       dz1#=1
  1141.     ENDIF
  1142.     GOSUB form_matrix
  1143.     cf!=FALSE
  1144.   ENDIF
  1145.   IF a_ctr|=on| OR a_scl|=on| OR axes|=on|
  1146.     IF a_scl|=on|
  1147.       PRINT ''"Auto-scaling"
  1148.     ENDIF
  1149.     IF a_ctr|=on|
  1150.       PRINT ''"Auto-centering"
  1151.     ENDIF
  1152.     IF axes|=on|
  1153.       PRINT ''"Calculating Axes"
  1154.     ENDIF
  1155.     GOSUB calcsxsyhilo
  1156.     IF a_scl|=on|
  1157.       GOSUB autoscale
  1158.     ENDIF
  1159.     IF graph!=FALSE
  1160.       GOTO graph_done
  1161.     ENDIF
  1162.     IF a_ctr|=on|
  1163.       GOSUB autocenter
  1164.     ENDIF
  1165.     IF graph!=FALSE
  1166.       GOTO graph_done
  1167.     ENDIF
  1168.   ENDIF
  1169.   CLS
  1170.   IF three_d! AND hide_lines|=on|
  1171.     PRINT
  1172.     PRINT ''"Calculating eye distances"
  1173.     GOSUB eye_dist
  1174.     PRINT ''"Sorting"
  1175.     GOSUB quick_sort
  1176.     CLS
  1177.   ENDIF
  1178.   IF axes|=on|
  1179.     GOSUB drwaxes
  1180.   ENDIF
  1181.   IF grid_lines|=on| AND three_d!=FALSE
  1182.     GOSUB drw_grid
  1183.   ENDIF
  1184.   IF three_d! AND hide_lines|=on|
  1185.     GOSUB hidden_lines
  1186.   ELSE
  1187.     IF lintx%(type|)<>0 !If the line interval is 0 for one axis then skip it
  1188.       GOSUB xaxis
  1189.     ENDIF
  1190.   ENDIF
  1191.   IF three_d! AND hide_lines|=off|
  1192.     IF linty%(type|)<>0
  1193.       GOSUB yaxis
  1194.     ENDIF
  1195.   ENDIF
  1196. graph_done:
  1197.   FOR i#=15 TO 0 STEP -1
  1198.     SOUND 1,i#,12,5
  1199.     PAUSE 1
  1200.   NEXT i#
  1201. RETURN
  1202. PROCEDURE form_matrix
  1203.   ' MMMMMMMMMMMMMMMMMMMMMMM-Form the Matrix-MMMMMMMMMMMMMMMMMMMMMMM
  1204.   ' Find the midpoint of the graph
  1205.   x#=(xlo#+xhi#)/2
  1206.   y#=(ylo#+yhi#)/2
  1207.   z#=(zlo#+zhi#)/2
  1208.   fx#=x#
  1209.   fy#=y#
  1210.   fz#=z#
  1211.   IF NOT three_d! !Position eye perpendicular to graph
  1212.     x#=0
  1213.     ey%(type|)=y#
  1214.     ez%(type|)=z#
  1215.   ENDIF
  1216.   ' Vectors from eye position to mid point
  1217.   m7#=ex%(type|)-fx#
  1218.   m8#=ey%(type|)-fy#
  1219.   m9#=ez%(type|)-fz#
  1220.   IF m9#=0
  1221.     m9#=0.0001 !Can't let this be zero
  1222.   ENDIF
  1223.   ' Calcualte eye distance
  1224.   ed#=SQR(ex%(type|)*ex%(type|)+ey%(type|)*ey%(type|)+ez%(type|)*ez%(type|))
  1225.   IF ed#=0
  1226.     ed#=1 !Don't let it be zero
  1227.   ENDIF
  1228.   IF NOT three_d!
  1229.     ed#=1E+08 !Remove perspective effect from 2-D graphs
  1230.   ELSE
  1231.     IF type|<>rect|
  1232.       ed#=ed#+100 !Take out some perspective effect from the other graphs
  1233.     ENDIF
  1234.   ENDIF
  1235.   DIV m7#,ed#
  1236.   DIV m8#,ed#
  1237.   DIV m9#,ed#
  1238.   m6#=m7#*m7#+m8#*m8#
  1239.   IF m6#=0 OR m9#<0
  1240.     IF m6#=0
  1241.       m4#=0
  1242.       m5#=1
  1243.     ENDIF
  1244.     IF m9#<0
  1245.       m4#=m7#
  1246.       m5#=m8#
  1247.       DIV m6#,-m9#
  1248.     ENDIF
  1249.   ELSE
  1250.     m4#=-m7#
  1251.     m5#=-m8#
  1252.     DIV m6#,m9#
  1253.   ENDIF
  1254.   m1#=m5#*m9#-m6#*m8#
  1255.   m2#=m6#*m7#-m4#*m9#
  1256.   m3#=m4#*m8#-m5#*m7#
  1257.   mx#=SQR(m4#*m4#+m5#*m5#+m6#*m6#)
  1258.   DIV m4#,mx#
  1259.   DIV m5#,mx#
  1260.   DIV m6#,mx#
  1261.   mx#=SQR(m1#*m1#+m2#*m2#+m3#*m3#)
  1262.   DIV m1#,mx#
  1263.   DIV m2#,mx#
  1264.   DIV m3#,mx#
  1265. RETURN
  1266. PROCEDURE kolorit
  1267.   ' CCCCCCCCCCCCCCCCCCCCCC-Color the Graph-CCCCCCCCCCCCCCCCCCCCCCCC
  1268.   ADD qz1#,qz2#
  1269.   DIV qz1#,2
  1270.   colrb%=INT((zhi#-qz1#)/dz1#)
  1271.   IF colrb%>13
  1272.     colrb%=13
  1273.   ENDIF
  1274.   IF colrb%<0
  1275.     colrb%=0
  1276.   ENDIF
  1277.   COLOR colrtable|(colrb%+1)
  1278.   IF ptrn|=100
  1279.     DEFFILL colrtable|(colrb%+1),0,0
  1280.   ELSE
  1281.     DEFFILL colrtable|(colrb%+1),2,ptrn|
  1282.   ENDIF
  1283. RETURN
  1284. PROCEDURE rect
  1285.   ' RRRRRRRRRRRRRRR-Compute Rectangular Coordinates-RRRRRRRRRRRRRRR
  1286.   funct_error!=FALSE
  1287.   ON ERROR GOSUB discont_funct  !Trap function errors
  1288.   dx#=(maxx#(type|)-minx#(type|))/pntint_x%(type|)
  1289.   dy#=(maxy#(type|)-miny#(type|))/pntint_y%(type|)
  1290.   x#=minx#(type|)-dx#
  1291.   y0#=miny#(type|)-dy#
  1292.   firstpass%=1
  1293.   i%=0
  1294.   REPEAT
  1295.     ADD x#,dx#
  1296.     y#=y0#
  1297.     j%=0
  1298.     REPEAT
  1299.       ADD y#,dy#
  1300.       IF custom_funct!(type|)=TRUE
  1301.         var1#=x#
  1302.         var2#=y#
  1303.         GOSUB evaluate
  1304.         z#=stack#(stack_ptr%)
  1305.       ELSE
  1306.         ON equat%(type|)+1 GOSUB rec0,rec1,rec2,rec3,rec4,rec5,rec6,rec7,rec8,rec9,rec10,rec11,rec12,rec13,rec14,rec15,rec16
  1307.       ENDIF
  1308.       DEC calc_points%
  1309.       PRINT AT(21,4);calc_points%;" "
  1310.       IF NOT funct_error!
  1311.         px#(i%,j%)=x#
  1312.         py#(i%,j%)=y#
  1313.         pz#(i%,j%)=z#
  1314.         IF z#<max_limit#(type|) AND z#>min_limit#(type|)
  1315.           GOSUB hilo
  1316.         ELSE
  1317.           pz#(i%,j%)=funct_error%
  1318.         ENDIF
  1319.       ELSE
  1320.         pz#(i%,j%)=funct_error%
  1321.       ENDIF
  1322.       INC j%
  1323.       funct_error!=FALSE
  1324.     UNTIL j%=pntint_y%(type|)+1
  1325.     INC i%
  1326.   UNTIL i%=pntint_x%(type|)+1
  1327.   ON ERROR
  1328. RETURN
  1329. PROCEDURE spheric
  1330.   ' SSSSSSSSSSSSSSSSSSSS-Spherical Coordinates-SSSSSSSSSSSSSSSSSSSS
  1331.   ' Set initial spherical values
  1332.   min_phi#=minx#(type|)
  1333.   max_phi#=maxx#(type|)
  1334.   min_theta#=miny#(type|)
  1335.   max_theta#=maxy#(type|)
  1336.   pntint_phi%=pntint_x%(type|)
  1337.   pntint_theta%=pntint_y%(type|)
  1338.   dphi#=(max_phi#-min_phi#)/pntint_phi%
  1339.   dtheta#=(max_theta#-min_theta#)/pntint_theta%
  1340.   phi#=min_phi#-dphi#
  1341.   theta0#=min_theta#-dtheta#
  1342.   firstpass%=1
  1343.   ON ERROR GOSUB discont_funct
  1344.   i%=0
  1345.   ' -- Compute spherical coords & convert to rectangular --
  1346.   REPEAT
  1347.     ADD phi#,dphi#
  1348.     theta#=theta0#
  1349.     j%=0
  1350.     REPEAT
  1351.       ADD theta#,dtheta#
  1352.       IF custom_funct!(type|)
  1353.         var1#=phi#
  1354.         var2#=theta#
  1355.         GOSUB evaluate
  1356.         IF NOT funct_error!
  1357.           r#=stack#(stack_ptr%)
  1358.         ENDIF
  1359.       ELSE
  1360.         ON equat%(type|)+1 GOSUB sph0,sph1,sph2,sph3,sph4,sph5,sph6,sph7,sph8,sph9,sph10,sph11,sph12,sph13,sph14,sph15
  1361.       ENDIF
  1362.       DEC calc_points%
  1363.       PRINT AT(21,4);calc_points%;" "
  1364.       IF NOT funct_error!
  1365.         ' Convert to rectangular values
  1366.         px#(i%,j%)=r#*SIN(phi#)*COS(theta#)
  1367.         py#(i%,j%)=r#*SIN(phi#)*SIN(theta#)
  1368.         pz#(i%,j%)=r#*COS(phi#)
  1369.         IF r#<max_limit#(type|) AND r#>min_limit#(type|)
  1370.           GOSUB hilo
  1371.         ELSE
  1372.           pz#(i%,j%)=funct_error%
  1373.         ENDIF
  1374.       ELSE
  1375.         pz#(i%,j%)=funct_error%
  1376.       ENDIF
  1377.       INC j%
  1378.       funct_error!=FALSE
  1379.     UNTIL j%=pntint_theta%+1
  1380.     INC i%
  1381.   UNTIL i%=pntint_phi%+1
  1382.   ON ERROR
  1383. RETURN
  1384. PROCEDURE cylin
  1385.   ' ++++++++++++++++++++Cylindrical Coordinates++++++++++++++++++++
  1386.   ' Set initial cylindrical values
  1387.   funct_error!=FALSE
  1388.   min_theta#=minx#(type|)
  1389.   max_theta#=maxx#(type|)
  1390.   minz#=miny#(type|)
  1391.   maxz#=maxy#(type|)
  1392.   pntint_theta%=pntint_x%(type|)
  1393.   ' Pntint_theta is the number of theta intervals
  1394.   pntint_z%=pntint_y%(type|)
  1395.   ON ERROR GOSUB discont_funct
  1396.   dtheta#=(max_theta#-min_theta#)/pntint_theta%
  1397.   dz#=(maxz#-minz#)/pntint_z%
  1398.   z#=minz#-dz#
  1399.   z0#=min_z#-dz#
  1400.   firstpass%=1
  1401.   i%=0
  1402.   ' CCCC-Compute Cylindrical coords & convert to rectangular-CCCC
  1403.   REPEAT
  1404.     ADD theta#,dtheta#
  1405.     z#=z0#
  1406.     j%=0
  1407.     REPEAT
  1408.       ADD z#,dz#
  1409.       IF custom_funct!(type|)=TRUE
  1410.         var1#=z#
  1411.         var2#=theta#
  1412.         GOSUB evaluate
  1413.         IF NOT funct_error!
  1414.           r#=stack#(stack_ptr%)
  1415.         ENDIF
  1416.       ELSE
  1417.         ON equat%(type|)+1 GOSUB cyl0,cyl1,cyl2,cyl3,cyl4,cyl5,cyl6,cyl7,cyl8,cyl9,cyl10,cyl11,cyl12,cyl13,cyl14,cyl15,cyl16
  1418.       ENDIF
  1419.       DEC calc_points%
  1420.       PRINT AT(21,4);calc_points%;" "
  1421.       IF NOT funct_error!
  1422.         px#(i%,j%)=r#*COS(theta#)
  1423.         py#(i%,j%)=r#*SIN(theta#)
  1424.         pz#(i%,j%)=z#
  1425.         IF r#<max_limit#(type|) AND r#>min_limit#(type|)
  1426.           GOSUB hilo
  1427.         ELSE
  1428.           pz#(i%,j%)=funct_error%
  1429.         ENDIF
  1430.       ELSE
  1431.         pz#(i%,j%)=funct_error%
  1432.       ENDIF
  1433.       INC j%
  1434.       funct_error!=FALSE
  1435.     UNTIL j%=pntint_z%+1
  1436.     INC i%
  1437.   UNTIL i%=pntint_theta%+1
  1438.   ON ERROR
  1439. RETURN
  1440. PROCEDURE cart
  1441.   ' ~~~~~~~~~~~~~~~~~~~~~~~~~~-Cartesian-~~~~~~~~~~~~~~~~~~~~~~~~~~
  1442.   ' Plotted on the Z-Y plane..X is plotted on Y axis and Y on the Z axis
  1443.   ' Confusing isn't it?!
  1444.   ' Set the initial cartesian values
  1445.   ON ERROR GOSUB discont_funct
  1446.   funct_error!=FALSE
  1447.   dx#=(maxx#(type|)-minx#(type|))/pntint_y%(type|)
  1448.   x#=minx#(type|)-dx#
  1449.   firstpass%=1
  1450.   i%=0
  1451.   j%=0
  1452.   ' Compute Cartesian Points and move to Y-Z plane
  1453.   REPEAT
  1454.     ADD x#,dx#
  1455.     IF custom_funct!(type|)
  1456.       var1#=x#
  1457.       GOSUB evaluate
  1458.       IF NOT funct_error!
  1459.         y#=stack#(stack_ptr%)
  1460.       ENDIF
  1461.     ELSE
  1462.       ON equat%(type|)+1 GOSUB car0,car1,car2,car3,car4,car5,car6,car7,car8,car9,car10,car11,car12,car13,car14,car15
  1463.     ENDIF
  1464.     DEC calc_points%
  1465.     PRINT AT(21,4);calc_points%;" "
  1466.     IF NOT funct_error!
  1467.       px#(i%,j%)=0
  1468.       py#(i%,j%)=x#
  1469.       pz#(i%,j%)=y#
  1470.       z#=y#
  1471.       IF z#<max_limit#(type|) AND z#>min_limit#(type|)
  1472.         GOSUB hilo
  1473.       ELSE
  1474.         pz#(i%,j%)=funct_error%
  1475.       ENDIF
  1476.     ELSE
  1477.       pz#(i%,j%)=funct_error%
  1478.     ENDIF
  1479.     INC j%
  1480.     funct_error!=FALSE
  1481.   UNTIL j%=pntint_y%(type|)+1
  1482.   ON ERROR
  1483. RETURN
  1484. PROCEDURE polar
  1485.   ' PPPPPPPPPPPPPPPPPPPPPPPPPP-Polar-PPPPPPPPPPPPPPPPPPPPPPPPPPPPPP
  1486.   ' Set initial polar values
  1487.   ON ERROR GOSUB discont_funct
  1488.   min_theta#=minx#(type|)
  1489.   max_theta#=maxx#(type|)
  1490.   pntint_theta%=pntint_y%(type|)
  1491.   dtheta#=(max_theta#-min_theta#)/pntint_theta%
  1492.   theta#=min_theta#-dtheta#
  1493.   firstpass%=1
  1494.   i%=0
  1495.   j%=0
  1496.   discont!=FALSE
  1497.   ' Compute Polar points and convert to rectangular
  1498.   ' Plotted on the Y-Z axis like cartesian
  1499.   REPEAT
  1500.     ADD theta#,dtheta#
  1501.     IF custom_funct!(type|)=TRUE
  1502.       var1#=theta#
  1503.       GOSUB evaluate
  1504.       IF NOT funct_error!
  1505.         r#=stack#(stack_ptr%)
  1506.       ENDIF
  1507.     ELSE
  1508.       ON equat%(type|)+1 GOSUB pol0,pol1,pol2,pol3,pol4,pol5,pol6,pol7,pol8,pol9,pol10,pol11,pol12,pol13,pol14,pol15
  1509.     ENDIF
  1510.     DEC calc_points%
  1511.     PRINT AT(21,4);calc_points%;" "
  1512.     IF NOT funct_error!
  1513.       y#=r#*SIN(theta#)
  1514.       z#=r#*COS(theta#)
  1515.       px#(i%,j%)=0
  1516.       py#(i%,j%)=z# !Turn it sideways to be conventional
  1517.       pz#(i%,j%)=y#
  1518.       IF r#<max_limit#(type|) AND r#>min_limit#(type|)
  1519.         IF discont!=TRUE !If we moved from discontinuous to continuous area
  1520.           GOSUB fnd_cont_pnt(theta#,dtheta#)
  1521.         ENDIF
  1522.         GOSUB hilo
  1523.       ELSE
  1524.         pz#(i%,j%)=funct_error%
  1525.       ENDIF
  1526.       discont!=FALSE
  1527.     ELSE
  1528.       IF j%<>0 AND discont!=FALSE !If we moved from continuous to discontinuous
  1529.         ' and it is not the first point
  1530.         GOSUB fnd_cont_pnt(theta#,dtheta#)
  1531.         IF r#<max_limit#(type|) AND r#>min_limit#(type|)
  1532.           GOSUB hilo
  1533.         ENDIF
  1534.       ELSE
  1535.         pz#(i%,j%)=funct_error%
  1536.       ENDIF
  1537.       IF funct_error!=TRUE
  1538.         discont!=TRUE
  1539.       ENDIF
  1540.     ENDIF
  1541.     INC j%
  1542.     funct_error!=FALSE
  1543.   UNTIL j%=pntint_theta%+1
  1544.   ON ERROR
  1545. RETURN
  1546. PROCEDURE xaxis
  1547.   ' XXXXXXXXXXXXXXXXXXX-Perpendicular to x-axis-XXXXXXXXXXXXXXXXXXX
  1548.   COLOR 1
  1549.   FOR i%=0 TO pntint_x%(type|) STEP lintx%(type|)
  1550.     FOR j%=0 TO pntint_y%(type|)
  1551.       qx#=px#(i%,j%)
  1552.       qy#=py#(i%,j%)
  1553.       qz#=pz#(i%,j%)
  1554.       IF pz#(i%,j%)<>funct_error%
  1555.         GOSUB calcsxsy
  1556.         IF j%=0 OR funct_error!
  1557.           x%(0)=sx#
  1558.           y%(0)=sy#
  1559.           qz1#=pz#(i%,j%)
  1560.           funct_error!=FALSE
  1561.         ELSE
  1562.           x%(1)=sx#
  1563.           y%(1)=sy#
  1564.           qz2#=pz#(i%,j%)
  1565.           IF kolor!
  1566.             GOSUB kolorit
  1567.           ENDIF
  1568.           POLYLINE 2,x%(),y%()
  1569.           x%(0)=sx#
  1570.           y%(0)=sy#
  1571.           qz1#=qz2#
  1572.         ENDIF
  1573.       ELSE
  1574.         funct_error!=TRUE
  1575.       ENDIF
  1576.     NEXT j%
  1577.   NEXT i%
  1578. RETURN
  1579. PROCEDURE yaxis
  1580.   ' YYYYYYYYYYYYYYYYYYY-Perpendicular to y-axis-YYYYYYYYYYYYYYYYYYY
  1581.   COLOR 1
  1582.   FOR j%=0 TO pntint_y%(type|) STEP linty%(type|)
  1583.     FOR i%=o# TO pntint_x%(type|)
  1584.       qx#=px#(i%,j%)
  1585.       qy#=py#(i%,j%)
  1586.       qz#=pz#(i%,j%)
  1587.       IF pz#(i%,j%)<>funct_error%
  1588.         GOSUB calcsxsy
  1589.         IF i%=0 OR funct_error!
  1590.           x%(0)=sx#
  1591.           y%(0)=sy#
  1592.           qz1#=pz#(i%,j%)
  1593.           funct_error!=FALSE
  1594.         ELSE
  1595.           x%(1)=sx#
  1596.           y%(1)=sy#
  1597.           qz2#=pz#(i%,j%)
  1598.           IF kolor!
  1599.             GOSUB kolorit
  1600.           ENDIF
  1601.           POLYLINE 2,x%(),y%()
  1602.           x%(0)=sx#
  1603.           y%(0)=sy#
  1604.           qz1#=qz2#
  1605.         ENDIF
  1606.       ELSE
  1607.         funct_error!=TRUE
  1608.       ENDIF
  1609.     NEXT i%
  1610.   NEXT j%
  1611. RETURN
  1612. PROCEDURE hidden_lines
  1613.   ' XXXXXXXXXXXXXXXXXXX-Hidden line routine-XXXXXXXXXXXXXXXXXXX
  1614.   COLOR 1
  1615.   IF ptrn|=100
  1616.     DEFFILL 1,0,0
  1617.   ELSE
  1618.     DEFFILL 1,2,ptrn|
  1619.   ENDIF
  1620.   n%=0
  1621.   REPEAT
  1622.     qz1#=zlo# !initial values for color bands
  1623.     qz2#=zhi#
  1624.     funct_error!=FALSE
  1625.     i%=pnt_no%(n%)/pntint_y%(type|)
  1626.     j%=pnt_no%(n%) MOD pntint_y%(type|)
  1627.     k%=0
  1628.     x%=i%
  1629.     y%=j%
  1630.     GOSUB x_y_arrayfill
  1631.     INC x%
  1632.     INC k%
  1633.     GOSUB x_y_arrayfill
  1634.     INC y%
  1635.     INC k%
  1636.     GOSUB x_y_arrayfill
  1637.     DEC x%
  1638.     INC k%
  1639.     GOSUB x_y_arrayfill
  1640.     x%(4)=x%(0)
  1641.     y%(4)=y%(0)
  1642.     IF NOT funct_error!
  1643.       IF kolor!
  1644.         GOSUB kolorit
  1645.       ENDIF
  1646.       POLYFILL 5,x%(),y%()
  1647.       IF ptrn|>2 AND ptrn|<9
  1648.         COLOR colrtable|(15)
  1649.         IF ptrn|=8
  1650.           COLOR colrtable|(0)
  1651.         ENDIF
  1652.       ENDIF
  1653.       POLYLINE 5,x%(),y%()
  1654.     ENDIF
  1655.     INC n%
  1656.   UNTIL n%=no_pnts%
  1657. RETURN
  1658. PROCEDURE x_y_arrayfill
  1659.   ' ---------- Fill the array for polyfill ------------
  1660.   qx#=px#(x%,y%)
  1661.   qy#=py#(x%,y%)
  1662.   qz#=pz#(x%,y%)
  1663.   IF qz#<>funct_error%
  1664.     IF kolor!
  1665.       qz1#=MAX(qz#,qz1#)
  1666.       qz2#=MIN(qz#,qz2#)
  1667.     ENDIF
  1668.     GOSUB calcsxsy
  1669.     x%(k%)=sx#
  1670.     y%(k%)=sy#
  1671.   ELSE
  1672.     funct_error!=TRUE
  1673.   ENDIF
  1674. RETURN
  1675. PROCEDURE eye_dist
  1676.   ' ------------ calculate the eye distances -------------
  1677.   i%=0
  1678.   REPEAT
  1679.     j%=0
  1680.     REPEAT
  1681.       IF pz#(i%,j%)<>funct_error%
  1682.         edx#=ABS(ex%(type|)-px#(i%,j%))
  1683.         edy#=ABS(ey%(type|)-py#(i%,j%))
  1684.         edz#=ABS(ez%(type|)-pz#(i%,j%))
  1685.         ed_sur0#=edx#+edy#+edz#
  1686.         edx1#=ABS(ex%(type|)-px#(i%+1,j%+1))
  1687.         edy1#=ABS(ey%(type|)-py#(i%+1,j%+1))
  1688.         edz1#=ABS(ez%(type|)-pz#(i%+1,j%+1))
  1689.         ed_sur1#=edx1#+edy1#+edz1#
  1690.         ed_surface#(i%*pntint_y%(type|)+j%)=(ed_sur0#+ed_sur1#)/2
  1691.       ELSE
  1692.         ed_surface#(i%*pntint_y%(type|)+j%)=funct_error%
  1693.       ENDIF
  1694.       INC j%
  1695.     UNTIL j%=pntint_y%(type|)
  1696.     INC i%
  1697.   UNTIL i%=pntint_x%(type|)
  1698. RETURN
  1699. PROCEDURE quick_sort
  1700.   ' ---------------- Sort the eye distances --------------
  1701.   no_pnts%=pntint_x%(type|)*pntint_y%(type|)
  1702.   ' Fill the pnt_no%() array
  1703.   i%=0
  1704.   REPEAT
  1705.     pnt_no%(i%)=i%
  1706.     INC i%
  1707.   UNTIL i%=no_pnts%+1
  1708.   GOSUB quicksort(*ed_surface#(),0,no_pnts%-1)
  1709. RETURN
  1710. PROCEDURE quicksort(str.arr%,l%,r%)
  1711.   LOCAL x#
  1712.   SWAP *str.arr%,ed_surface#()
  1713.   @quick(l%,r%)
  1714.   SWAP *str.arr%,ed_surface#()
  1715. RETURN
  1716. PROCEDURE quick(l%,r%)
  1717.   LOCAL ll%,rr%
  1718.   ll%=l%
  1719.   rr%=r%
  1720.   x#=ed_surface#((l%+r%)/2)
  1721.   REPEAT
  1722.     WHILE ed_surface#(l%)>x#
  1723.       INC l%
  1724.     WEND
  1725.     WHILE ed_surface#(r%)<x#
  1726.       DEC r%
  1727.     WEND
  1728.     IF l%<=r%
  1729.       SWAP ed_surface#(l%),ed_surface#(r%)
  1730.       SWAP pnt_no%(l%),pnt_no%(r%)
  1731.       INC l%
  1732.       DEC r%
  1733.     ENDIF
  1734.   UNTIL l%>r%
  1735.   IF ll%<r%
  1736.     @quick(ll%,r%)
  1737.   ENDIF
  1738.   IF l%<rr%
  1739.     @quick(l%,rr%)
  1740.   ENDIF
  1741. RETURN
  1742. PROCEDURE hilo
  1743.   ' hhhhhhhhhhhhhhhhhhhhhhhhhh-Find hi/lo-hhhhhhhhhhhhhhhhhhhhhhhhh
  1744.   ' Find high and low values in each direction
  1745.   IF firstpass%=1
  1746.     zlo#=pz#(i%,j%)
  1747.     zhi#=pz#(i%,j%)
  1748.     xhi#=px#(i%,j%)
  1749.     xlo#=px#(i%,j%)
  1750.     yhi#=py#(i%,j%)
  1751.     ylo#=py#(i%,j%)
  1752.     firstpass%=2
  1753.   ELSE
  1754.     IF pz#(i%,j%)>zhi#
  1755.       zhi#=pz#(i%,j%)
  1756.       izhi%=i%
  1757.       jzhi%=j%
  1758.     ENDIF
  1759.     xhi#=MAX(px#(i%,j%),xhi#)
  1760.     yhi#=MAX(py#(i%,j%),yhi#)
  1761.     zlo#=MIN(pz#(i%,j%),zlo#)
  1762.     xlo#=MIN(px#(i%,j%),xlo#)
  1763.     ylo#=MIN(py#(i%,j%),ylo#)
  1764.   ENDIF
  1765. RETURN
  1766. PROCEDURE drwaxes
  1767.   ' dddddddddddddddddddddddddd-Draw Axes-dddddddddddddddddddddddddd
  1768.   xahi#=MAX(ABS(xhi#),ABS(xlo#))
  1769.   yahi#=MAX(ABS(yhi#),ABS(ylo#))
  1770.   zahi#=MAX(ABS(zhi#),ABS(zlo#))
  1771.   qahi#=MAX(xahi#,yahi#,zahi#)
  1772.   qx#=0
  1773.   qy#=0
  1774.   qz#=0
  1775.   GOSUB calcsxsy
  1776.   originx#=sx#
  1777.   originy#=sy#
  1778.   IF res|=med|
  1779.     COLOR 3
  1780.   ELSE
  1781.     COLOR 1
  1782.   ENDIF
  1783.   qx#=0
  1784.   qy#=0
  1785.   qz#=zahi#+0.3*qahi#
  1786.   GOSUB calcsxsy
  1787.   DRAW originx#,originy# TO sx#,sy#
  1788.   IF three_d!
  1789.     TEXT sx#+2,sy#-2,"z"
  1790.   ELSE
  1791.     TEXT sx#+2,sy#-2,"y"
  1792.   ENDIF
  1793.   qx#=0
  1794.   qy#=yahi#+0.3*qahi#
  1795.   qz#=0
  1796.   GOSUB calcsxsy
  1797.   DRAW originx#,originy# TO sx#,sy#
  1798.   IF three_d!
  1799.     TEXT sx#+2,sy#-2,"y"
  1800.   ELSE
  1801.     TEXT sx#+2,sy#-2,"x"
  1802.   ENDIF
  1803.   IF three_d!
  1804.     qx#=xahi#+0.3*qahi#
  1805.     qy#=0
  1806.     qz#=0
  1807.     GOSUB calcsxsy
  1808.     DRAW originx#,originy# TO sx#,sy#
  1809.     TEXT sx#+2,sy#-2,"x"
  1810.   ENDIF
  1811.   DEFLINE 2,1,0,0
  1812.   qx#=0
  1813.   qy#=0
  1814.   qz#=-zahi#-0.3*qahi#
  1815.   GOSUB calcsxsy
  1816.   DRAW originx#,originy# TO sx#,sy#
  1817.   qx#=0
  1818.   qy#=-yahi#-0.3*qahi#
  1819.   qz#=0
  1820.   GOSUB calcsxsy
  1821.   DRAW originx#,originy# TO sx#,sy#
  1822.   IF three_d!
  1823.     qx#=-xahi#-0.3*qahi#
  1824.     qy#=0
  1825.     qz#=0
  1826.     GOSUB calcsxsy
  1827.     DRAW originx#,originy# TO sx#,sy#
  1828.   ENDIF
  1829.   DEFLINE 1,1,0,0
  1830. RETURN
  1831. PROCEDURE screenswap
  1832.   ' ________Swap the screens________
  1833.   IF scrn|=0   !If we are on the menu screen
  1834.     IF res|<>hi|
  1835.       SETCOLOR 1,sav_colr%(0)
  1836.       SETCOLOR 2,sav_colr%(1)
  1837.     ENDIF
  1838.     MENU KILL
  1839.     MENU OFF
  1840.     SPUT screen1$ !Return the graph screen
  1841.     scrn|=1
  1842.     GOSUB hide_mouse
  1843.   ELSE
  1844.     scrn|=0
  1845.     CLS
  1846.     FOR i%=1 TO 2
  1847.       GOSUB get_color
  1848.       sav_colr%(i%-1)=hue%
  1849.     NEXT i%
  1850.     GOSUB param_menu !Reprint the menu screen
  1851.     PAUSE 30
  1852.   ENDIF
  1853. RETURN
  1854. PROCEDURE open_file
  1855.   ' ooooooooooooooooooooooooooo-Open file-ooooooooooooooooooooooooo
  1856.   ON ERROR GOSUB disk_err
  1857.   drive$=CHR$(GEMDOS(25)+65)
  1858.   filename$=""
  1859.   IF DIR$(0)<>""
  1860.     graphfil$=drive$+":"+DIR$(0)+"\*"+extender$
  1861.   ELSE
  1862.     graphfil$=drive$+":\*"+extender$
  1863.   ENDIF
  1864. select:
  1865.   FILESELECT graphfil$,"",filename$
  1866.   IF filename$<>""
  1867.     IF filename$<>drive$+":" AND RIGHT$(filename$)<>"\"
  1868.       period%=INSTR(filename$,".")
  1869.       IF period%=0
  1870.         filename$=filename$+extender$
  1871.       ELSE
  1872.         IF choice|<>5
  1873.           filename$=LEFT$(filename$,period%-1)+extender$
  1874.         ENDIF
  1875.       ENDIF
  1876.       backslash%=-1
  1877.       REPEAT
  1878.         dum%=backslash%
  1879.         INC dum%
  1880.         backslash%=INSTR(dum%,filename$,"\")
  1881.       UNTIL backslash%=0
  1882.       CHDRIVE ASC(LEFT$(filename$))-64
  1883.       path$=MID$(filename$,INSTR(filename$,"\"),dum%-INSTR(filename$,"\")-1)
  1884.       IF path$<>""
  1885.         CHDIR path$
  1886.       ELSE
  1887.         CHDIR "\"
  1888.       ENDIF
  1889.       DEFMOUSE 2
  1890.       IF choice|<>5
  1891.         OPEN "O",#1,filename$
  1892.         ON choice| GOSUB degas_save,neo_save,param_save,cad3d_save
  1893.       ELSE
  1894.         IF EXIST(filename$)
  1895.           GOSUB get_graph_file
  1896.         ELSE
  1897.           ALERT 1,"|File not found",1,"OK",dum%
  1898.         ENDIF
  1899.       ENDIF
  1900.     ENDIF
  1901.   ENDIF
  1902. abort_open:
  1903.   CLOSE #1
  1904.   DEFMOUSE 0
  1905.   ON ERROR
  1906. RETURN
  1907. PROCEDURE degas_save
  1908.   ' ssssssssssssssssssssssssss-Degas Save-sssssssssssssssssssssssss
  1909.   ' --- DEGAS file write ---
  1910.   degasheader$=MKI$(res|)
  1911.   FOR i%=0 TO 15
  1912.     IF i%<>1 AND i%<>2
  1913.       GOSUB get_color
  1914.     ELSE
  1915.       hue%=sav_colr%(i%-1)
  1916.     ENDIF
  1917.     degasheader$=degasheader$+MKI$(hue%)
  1918.   NEXT i%
  1919.   BPUT #1,VARPTR(degasheader$),34
  1920.   BPUT #1,VARPTR(screen1$),32000
  1921. RETURN
  1922. PROCEDURE neo_save
  1923.   ' nnnnnnnnnnnnnnnnnnnnnnnnnnn-NEO Save-nnnnnnnnnnnnnnnnnnnnnnnnnn
  1924.   ' -------- Neo Write ----------
  1925.   temp$=""
  1926.   temp$=temp$+MKL$(0)
  1927.   FOR i%=0 TO 15
  1928.     IF i%<>1 AND i%<>2
  1929.       GOSUB get_color
  1930.     ELSE
  1931.       hue%=sav_colr%(i%-1)
  1932.     ENDIF
  1933.     temp$=temp$+MKI$(hue%)
  1934.   NEXT i%
  1935.   FOR i%=1 TO 6
  1936.     temp$=temp$+MKI$(0)
  1937.   NEXT i%
  1938.   temp$=temp$+MKI$(&H801F)
  1939.   FOR i%=1 TO 39
  1940.     temp$=temp$+MKI$(0)
  1941.   NEXT i%
  1942.   BPUT #1,VARPTR(temp$),128
  1943.   BPUT #1,VARPTR(screen1$),32000
  1944. RETURN
  1945. PROCEDURE get_color
  1946.   ' ----- Get colors -----
  1947.   DPOKE CONTRL,26
  1948.   DPOKE CONTRL+2,0
  1949.   DPOKE CONTRL+6,2
  1950.   DPOKE INTIN,colrtable|(i%)
  1951.   DPOKE INTIN+2,1
  1952.   VDISYS
  1953.   rgb%(0)=DPEEK(INTOUT+2)
  1954.   rgb%(1)=DPEEK(INTOUT+4)
  1955.   rgb%(2)=DPEEK(INTOUT+6)
  1956.   FOR j%=0 TO 2
  1957.     rgb%(j%)=INT(rgb%(j%)/142)
  1958.   NEXT j%
  1959.   hue%=rgb%(0)*&H100+rgb%(1)*&H10+rgb%(2)
  1960. RETURN
  1961. PROCEDURE disk_err
  1962.   ' ----- Disk error procedure -----
  1963.   DEFMOUSE 0
  1964.   ' If the disk was write protected GEM already gave them an alert box so skip this one
  1965.   IF ERR<>-13
  1966.     ALERT 3,"  Disk Error.  | Operation Aborted. ",1,"Ok",dum%
  1967.     title!=TRUE
  1968.     CLS
  1969.     GOSUB param_menu
  1970.   ENDIF
  1971.   RESUME abort_open
  1972. RETURN
  1973. PROCEDURE param_save
  1974.   ' ggggggggggggggggggggggggg-Graph Save-gggggggggggggggggggggggggg
  1975.   ' --- Graph file write ---
  1976.   WRITE #1,p_file$
  1977.   WRITE #1,type|,custom_funct!(type|),cfunctlabel$(type|),equat%(type|),z%(type|),ex%(type|),ey%(type|),ez%(type|),cx%(type|),cy%(type|),minx#(type|),maxx#(type|)
  1978.   WRITE #1,miny#(type|),maxy#(type|),min_limit#(type|),max_limit#(type|),pntint_x%(type|),pntint_y%(type|),lintx%(type|),linty%(type|)
  1979.   FOR i%=1 TO 10
  1980.     WRITE #1,const#(type|,i%)
  1981.   NEXT i%
  1982. RETURN
  1983. PROCEDURE get_graph_file
  1984.   ' RRRRRRRRRRRRRRRRRRRRRRR-Read in a Graph-RRRRRRRRRRRRRRRRRRRRRRRR
  1985.   OPEN "I",#1,filename$
  1986.   INPUT #1,version$
  1987.   IF p_file$<>"PM-1.00"
  1988.     ALERT 3,"  |Error: Not a Parameters File.",1,"Ok",dum%
  1989.   ELSE
  1990.     INPUT #1,type|,custom_funct!(type|),cfunctlabel$(type|),equat%(type|),z%(type|),ex%(type|),ey%(type|),ez%(type|),cx%(type|),cy%(type|),minx#(type|),maxx#(type|)
  1991.     INPUT #1,miny#(type|),maxy#(type|),min_limit#(type|),max_limit#(type|),pntint_x%(type|),pntint_y%(type|),lintx%(type|),linty%(type|)
  1992.     IF pntint_x%(type|)>max_pts|
  1993.       pntint_x%(type|)=max_pts|
  1994.     ENDIF
  1995.     IF pntint_y%(type|)>max_pts|
  1996.       pntint_y%(type|)=max_pts|
  1997.     ENDIF
  1998.     FOR i%=1 TO 10
  1999.       INPUT #1,const#(type|,i%)
  2000.     NEXT i%
  2001.   ENDIF
  2002. RETURN
  2003. PROCEDURE param_menu
  2004.   ' mmmmmmmmmmmmmmmmmmmmmmm-Parameter Menu-mmmmmmmmmmmmmmmmmmmmmmmm
  2005.   ' Print the Main Menu screen
  2006.   SETCOLOR 1,0,0,6
  2007.   SETCOLOR 2,0,7,1
  2008.   DEFFILL colrtable|(0),2,8
  2009.   PBOX 33*rxf|,42*ryf|,309*rxf|,157*ryf|
  2010.   IF title!=TRUE !Do we need to redraw the box and title
  2011.     SPUT mscreen$
  2012.   ENDIF
  2013.   DEFTEXT 1,0,0,rtxt1|
  2014.   COLOR colrtable|(15)
  2015.   GOSUB funct_title
  2016.   GOSUB equation
  2017.   GOSUB zoom
  2018.   GOSUB eye
  2019.   GOSUB scrn_center
  2020.   GOSUB param1
  2021.   GOSUB param2
  2022.   GOSUB param3
  2023.   GOSUB pint
  2024.   GOSUB lint
  2025.   MENU d$()
  2026.   GOSUB mark_menu
  2027.   ON MENU GOSUB set_options
  2028. RETURN
  2029. PROCEDURE funct_title
  2030.   TEXT 20*rxf|,40*ryf|,SPACE$(sclear|)
  2031.   '  Text 20*Rxf%,43*Ryf%,Space$(Sclear%)
  2032.   type1$=type$(type|)+" Coordinates Parameters"
  2033.   TEXT 20*rxf|,43*ryf|,LEFT$("__________________________________",LEN(type1$))
  2034.   TEXT 20*rxf|,40*ryf|,type1$
  2035. RETURN
  2036. PROCEDURE equation
  2037.   TEXT 41*rxf|,53*ryf|,"Function:"
  2038.   GOSUB prntfunct
  2039.   IF res|=lo|
  2040.     DEFTEXT 1,0,0,4
  2041.   ENDIF
  2042.   IF custom_funct!(type|)=TRUE
  2043.     IF type|=rect|
  2044.       temp$="z="
  2045.     ELSE
  2046.       IF type|=cart|
  2047.         temp$="y="
  2048.       ELSE
  2049.         temp$="r="
  2050.       ENDIF
  2051.     ENDIF
  2052.     temp$=temp$+cfunctlabel$(type|)
  2053.   ELSE
  2054.     temp$=functlabel$
  2055.   ENDIF
  2056.   IF res|=lo| AND LEN(temp$)>44
  2057.     temp1$=LEFT$(temp$,31)
  2058.     TEXT 115*rxf|,53*ryf|,temp1$
  2059.     temp$=MID$(temp$,32)
  2060.   ENDIF
  2061.   TEXT 41*rxf|,61*ryf|,temp$
  2062.   DEFTEXT 1,0,0,rtxt1|
  2063. RETURN
  2064. PROCEDURE zoom
  2065.   '  Text 33*Rxf%,71*Ryf%,Space$(Sclear%)
  2066.   temp$="Zoom Factor="+STR$(INT(z%(type|)))
  2067.   TEXT 41*rxf|,71*ryf|,temp$
  2068. RETURN
  2069. PROCEDURE eye
  2070.   IF NOT three_d!
  2071.     temp$="Not Applicable"
  2072.   ELSE
  2073.     temp$="Ex="+STR$(ex%(type|))+"   Ey="+STR$(ey%(type|))+"   Ez="+STR$(ez%(type|))+"   "
  2074.   ENDIF
  2075.   '  Text 33*Rxf%,90*Ryf%,Space$(Sclear%)
  2076.   TEXT 41*rxf|,81*ryf|,"Eye Position:"
  2077.   TEXT 40*rxf|,90*ryf|,temp$
  2078. RETURN
  2079. PROCEDURE scrn_center
  2080.   '  Text 33*Rxf%,99*Ryf%,Space$(Sclear%)
  2081.   temp$="Screen Center: Cx="+STR$(cx%(type|))+"   Cy="+STR$(cy%(type|))
  2082.   TEXT 41*rxf|,99*ryf|,temp$
  2083. RETURN
  2084. PROCEDURE param1
  2085.   '  Text 33*Rxf%,109*Ryf%,Space$(Sclear%)
  2086.   IF type|=sphere| OR type|=polar| OR type|=cylin|
  2087.     temp$=paramx$(type|)+" Range: "+paramx$(type|)+"low="+STR$(INT(minx#(type|)*180/PI+0.01))+"° "+paramx$(type|)+"hi="+STR$(INT(maxx#(type|)*180/PI+0.01))+"°"
  2088.   ELSE
  2089.     temp$=paramx$(type|)+" Range: "+paramx$(type|)+"low="+STR$(minx#(type|))+" "+paramx$(type|)+"hi="+STR$(maxx#(type|))
  2090.   ENDIF
  2091.   TEXT 41*rxf|,109*ryf|,temp$
  2092. RETURN
  2093. PROCEDURE param2
  2094.   '  Text 33*Rxf%,119*Ryf%,Space$(Sclear%)
  2095.   IF type|=sphere|
  2096.     temp$=paramy$(type|)+" Range: "+paramy$(type|)+"low="+STR$(INT(miny#(type|)*180/PI+0.01))+"° "+paramy$(type|)+"hi="+STR$(INT(maxy#(type|)*180/PI+0.01))+"°"
  2097.   ENDIF
  2098.   IF type|=rect| OR type|=cylin|
  2099.     temp$=paramy$(type|)+" Range: "+paramy$(type|)+"low="+STR$(miny#(type|))+" "+paramy$(type|)+"hi="+STR$(maxy#(type|))
  2100.   ENDIF
  2101.   IF NOT three_d!
  2102.     temp$=paramy$(type|)+" Range: "+paramy$(type|)+"low="+STR$(min_limit#(type|))+" "+paramy$(type|)+"hi="+STR$(max_limit#(type|))
  2103.   ENDIF
  2104.   TEXT 41*rxf|,119*ryf|,temp$
  2105. RETURN
  2106. PROCEDURE param3
  2107.   '  Text 33*Rxf%,129*Ryf%,Space$(Sclear%)
  2108.   IF NOT three_d!
  2109.     temp$="Z Range: Not Applicable"
  2110.   ELSE
  2111.     temp$=paramz$(type|)+" Range: "+paramz$(type|)+"low="+STR$(min_limit#(type|))+" "+paramz$(type|)+"hi="+STR$(max_limit#(type|))
  2112.   ENDIF
  2113.   TEXT 41*rxf|,129*ryf|,temp$
  2114. RETURN
  2115. PROCEDURE pint
  2116.   '  Text 33*Rxf%,139*Ryf%,Space$(Sclear%)
  2117.   temp$="Point Intervals: "
  2118.   IF NOT three_d!
  2119.     temp$=temp$+"P"+paramx$(type|)+"="+STR$(pntint_y%(type|))
  2120.   ELSE
  2121.     temp$=temp$+"P"+paramx$(type|)+"="+STR$(pntint_x%(type|))+" P"+paramy$(type|)+"="+STR$(pntint_y%(type|))
  2122.   ENDIF
  2123.   TEXT 41*rxf|,139*ryf|,temp$
  2124. RETURN
  2125. PROCEDURE lint
  2126.   TEXT 33*rxf|,149*ryf|,SPACE$(sclear|)
  2127.   temp$="Line Intervals: "
  2128.   IF NOT three_d!
  2129.     IF x_int#==PI/4
  2130.       temp$="Grid Intervals: X=Trig Y="+LEFT$(STR$(y_int#),5)
  2131.     ELSE
  2132.       temp$="Grid Intervals: X="+STR$(x_int#)+" Y="+STR$(y_int#)
  2133.     ENDIF
  2134.   ELSE
  2135.     IF hide_lines|=on|
  2136.       temp$=temp$+"Not Applicable"
  2137.     ELSE
  2138.       temp$=temp$+"L"+paramx$(type|)+"="+STR$(lintx%(type|))+" L"+paramy$(type|)+"="+STR$(linty%(type|))
  2139.     ENDIF
  2140.   ENDIF
  2141.   TEXT 41*rxf|,149*ryf|,temp$
  2142. RETURN
  2143. PROCEDURE chg_params
  2144.   ' PPPPPPPPPPPPPPPPPPPPPP-Change Parameters-PPPPPPPPPPPPPPPPPPPPPP
  2145.   MOUSE micex&,micey&,dum%
  2146.   ' Mice!???
  2147.   IF micex&>20*rxf| AND micex&<33*rxf|
  2148.     IF micey&>45*ryf| AND micey&<54*ryf|
  2149.       GOSUB nwfunction
  2150.       GOSUB param_menu
  2151.     ENDIF
  2152.     IF micey&>63*ryf| AND micey&<72*ryf|
  2153.       a_scl|=off|
  2154.       GOSUB mark_menu
  2155.       PRINT AT(6,22);"Zoom=";
  2156.       FORM INPUT 4,temp$
  2157.       GOSUB clearit_all
  2158.       z%(type|)=ABS(INT(VAL(temp$)))
  2159.       IF z%(type|)=0
  2160.         z%(type|)=1
  2161.       ENDIF
  2162.       TEXT 33*rxf|,71*ryf|,SPACE$(sclear|)
  2163.       GOSUB zoom
  2164.     ENDIF
  2165.     IF micey&>73*ryf| AND micey&<82*ryf|
  2166.       IF three_d!
  2167.         PRINT AT(6,22);"Eye Position: Ex, Ey and Ez"
  2168.         PRINT AT(6,23);"Ex=";
  2169.         FORM INPUT 3,temp$
  2170.         ex%(type|)=INT(VAL(temp$))
  2171.         GOSUB clearit
  2172.         PRINT AT(6,23);"Ey=";
  2173.         FORM INPUT 3,temp$
  2174.         ey%(type|)=INT(VAL(temp$))
  2175.         GOSUB clearit
  2176.         PRINT AT(6,23);"Ez=";
  2177.         FORM INPUT 3,temp$
  2178.         ez%(type|)=INT(VAL(temp$))
  2179.         GOSUB clearit_all
  2180.         IF graph!<>FALSE
  2181.           GOSUB form_matrix
  2182.         ENDIF
  2183.         TEXT 33*rxf|,90*ryf|,SPACE$(sclear|)
  2184.         GOSUB eye
  2185.       ENDIF
  2186.     ENDIF
  2187.     IF micey&>91*ryf| AND micey&<100*ryf|
  2188.       a_ctr|=off|
  2189.       GOSUB mark_menu
  2190.       PRINT AT(6,22);"Center of Screen: Cx,Cy"
  2191.       PRINT AT(6,23);"Cx=";
  2192.       FORM INPUT 4,temp$
  2193.       cx%(type|)=INT(VAL(temp$))
  2194.       GOSUB clearit
  2195.       PRINT AT(6,23);"Cy=";
  2196.       FORM INPUT 4,temp$
  2197.       cy%(type|)=INT(VAL(temp$))
  2198.       GOSUB clearit_all
  2199.       TEXT 33*rxf|,99*ryf|,SPACE$(sclear|)
  2200.       GOSUB scrn_center
  2201.     ENDIF
  2202.     IF micey&>101*ryf| AND micey&<110*ryf|
  2203.     tryagain_x:
  2204.       PRINT AT(6,22);paramx$(type|)+" Values: "+paramx$(type|)+"lo,"+paramx$(type|)+"hi";
  2205.       PRINT AT(6,23);paramx$(type|)+"lo=";
  2206.       FORM INPUT 5,temp$
  2207.       GOSUB clearit
  2208.       GOSUB dec_val
  2209.       IF type|=rect| OR type|=cart|
  2210.         minx#(type|)=d_val#
  2211.       ELSE
  2212.         minx#(type|)=VAL(temp$)*PI/180
  2213.       ENDIF
  2214.       PRINT AT(6,23);paramx$(type|)+"hi=";
  2215.       FORM INPUT 5,temp$
  2216.       GOSUB clearit_all
  2217.       IF temp$<>""
  2218.         GOSUB dec_val
  2219.         IF type|=rect| OR type|=cart|
  2220.           maxx#(type|)=d_val#
  2221.         ELSE
  2222.           maxx#(type|)=VAL(temp$)*PI/180
  2223.         ENDIF
  2224.       ELSE
  2225.         maxx#(type|)=ABS(minx#(type|))
  2226.       ENDIF
  2227.       IF minx#(type|)>=maxx#(type|)
  2228.         GOSUB inp_error
  2229.         GOTO tryagain_x
  2230.       ENDIF
  2231.       cf!=TRUE
  2232.       TEXT 33*rxf|,109*ryf|,SPACE$(sclear|)
  2233.       GOSUB param1
  2234.     ENDIF
  2235.     IF micey&>111*ryf| AND micey&<120*ryf|
  2236.     tryagain_y:
  2237.       PRINT AT(6,22);paramy$(type|)+" Values: "+paramy$(type|)+"lo,"+paramy$(type|)+"hi";
  2238.       PRINT AT(6,23);paramy$(type|)+"lo=";
  2239.       FORM INPUT 5,temp$
  2240.       GOSUB clearit
  2241.       GOSUB dec_val
  2242.       IF type|=sphere|
  2243.         miny#(type|)=VAL(temp$)*PI/180
  2244.       ELSE
  2245.         IF NOT three_d!
  2246.           min_limit#(type|)=d_val#
  2247.         ELSE
  2248.           miny#(type|)=d_val#
  2249.         ENDIF
  2250.       ENDIF
  2251.       PRINT AT(6,23);paramy$(type|)+"hi=";
  2252.       FORM INPUT 5,temp$
  2253.       GOSUB clearit_all
  2254.       IF temp$<>""
  2255.         GOSUB dec_val
  2256.         IF type|=sphere|
  2257.           maxy#(type|)=VAL(temp$)*PI/180
  2258.         ELSE
  2259.           IF NOT three_d!
  2260.             max_limit#(type|)=d_val#
  2261.           ELSE
  2262.             maxy#(type|)=d_val#
  2263.           ENDIF
  2264.         ENDIF
  2265.       ELSE
  2266.         IF three_d!
  2267.           maxy#(type|)=ABS(miny#(type|))
  2268.         ELSE
  2269.           IF NOT three_d!
  2270.             max_limit#(type|)=ABS(min_limit#(type|))
  2271.           ENDIF
  2272.         ENDIF
  2273.       ENDIF
  2274.       IF three_d!
  2275.         IF miny#(type|)>=maxy#(type|)
  2276.           GOSUB inp_error
  2277.           GOTO tryagain_y
  2278.         ENDIF
  2279.       ELSE
  2280.         IF min_limit#(type|)>=max_limit#(type|)
  2281.           GOSUB inp_error
  2282.           GOTO tryagain_y
  2283.         ENDIF
  2284.       ENDIF
  2285.       cf!=TRUE
  2286.       TEXT 33*rxf|,119*ryf|,SPACE$(sclear|)
  2287.       GOSUB param2
  2288.     ENDIF
  2289.     IF micey&>121*ryf| AND micey&<130*ryf| AND type|<4
  2290.     tryagain_z:
  2291.       PRINT AT(6,22);paramz$(type|)+" Values: "+paramz$(type|)+"lo,"+paramz$(type|)+"hi";
  2292.       PRINT AT(6,23);paramz$(type|)+"lo=";
  2293.       FORM INPUT 5,temp$
  2294.       GOSUB clearit
  2295.       GOSUB dec_val
  2296.       min_limit#(type|)=d_val#
  2297.       PRINT AT(6,23);paramz$(type|)+"hi=";
  2298.       FORM INPUT 5,temp$
  2299.       GOSUB clearit_all
  2300.       IF temp$<>""
  2301.         GOSUB dec_val
  2302.         max_limit#(type|)=d_val#
  2303.         IF min_limit#(type|)>=max_limit#(type|)
  2304.           GOSUB inp_error
  2305.           GOTO tryagain_z
  2306.         ENDIF
  2307.       ELSE
  2308.         max_limit#(type|)=ABS(min_limit#(type|))
  2309.       ENDIF
  2310.       cf!=TRUE
  2311.       TEXT 33*rxf|,129*ryf|,SPACE$(sclear|)
  2312.       GOSUB param3
  2313.     ENDIF
  2314.     IF micey&>131*ryf| AND micey&<140*ryf|
  2315.       IF three_d!
  2316.         PRINT AT(6,22);"Point Intervals: P"+paramx$(type|)+",P"+paramy$(type|)
  2317.         PRINT AT(6,23);"P"+paramx$(type|)+"=";
  2318.         FORM INPUT 2,temp$
  2319.         pntint_x%(type|)=ABS(INT(VAL(temp$)))
  2320.         IF pntint_x%(type|)>max_pts|
  2321.           pntint_x%(type|)=max_pts|
  2322.         ENDIF
  2323.         IF pntint_x%(type|)=0
  2324.           pntint_x%(type|)=1
  2325.         ENDIF
  2326.         GOSUB clearit
  2327.       ENDIF
  2328.       IF three_d!
  2329.         PRINT AT(6,23);"P"+paramy$(type|)+"=";
  2330.         FORM INPUT 2,temp$
  2331.       ELSE
  2332.         PRINT AT(6,23);"P"+paramx$(type|)+"=";
  2333.         FORM INPUT 3,temp$
  2334.       ENDIF
  2335.       IF three_d! AND temp$=""
  2336.         pntint_y%(type|)=pntint_x%(type|)
  2337.       ELSE
  2338.         pntint_y%(type|)=ABS(INT(VAL(temp$)))
  2339.       ENDIF
  2340.       IF pntint_y%(type|)>max_pts| AND three_d!
  2341.         pntint_y%(type|)=max_pts|
  2342.       ENDIF
  2343.       IF pntint_y%(type|)=0
  2344.         pntint_y%(type|)=1
  2345.       ENDIF
  2346.       cf!=TRUE
  2347.       GOSUB clearit_all
  2348.       TEXT 33*rxf|,139*ryf|,SPACE$(sclear|)
  2349.       GOSUB pint
  2350.     ENDIF
  2351.     IF micey&>141*ryf| AND micey&<150*ryf|
  2352.       IF three_d! AND hide_lines|=off|
  2353.       tryagain_lint:
  2354.         PRINT AT(6,22);"Line Intervals: L"+paramx$(type|)+",L"+paramy$(type|)
  2355.         PRINT AT(6,23);"L"+paramx$(type|)+"=";
  2356.         FORM INPUT 2,temp$
  2357.         lintx%(type|)=ABS(INT(VAL(temp$)))
  2358.         GOSUB clearit
  2359.         PRINT AT(6,23);"L"+paramy$(type|)+"=";
  2360.         FORM INPUT 2,temp$
  2361.         linty%(type|)=ABS(INT(VAL(temp$)))
  2362.         GOSUB clearit_all
  2363.         '        Text 33*Rxf%,149*Ryf%,Space$(Sclear%)
  2364.         GOSUB lint
  2365.         IF lintx%(type|)>=pntint_x%(type|)/2 OR linty%(type|)>=pntint_y%(type|)/2
  2366.           PRINT AT(6,22);"◆Line Intervals must be less than"
  2367.           PRINT AT(6,23);"Points/2"
  2368.           PAUSE 150
  2369.           GOSUB clearit_all
  2370.           GOTO tryagain_lint
  2371.         ENDIF
  2372.         IF lintx%(type|)>5 OR linty%(type|)>5
  2373.           PRINT AT(5,23);"◆Line intervals must be less than 5"
  2374.           PAUSE 150
  2375.           GOSUB clearit_all
  2376.           GOTO tryagain_lint
  2377.         ENDIF
  2378.         IF lintx%(type|)=0 AND linty%(type|)=0
  2379.           PRINT AT(6,23);"◆Both Intervals may not be 0"
  2380.           PAUSE 150
  2381.           GOSUB clearit_all
  2382.           GOTO tryagain_lint
  2383.         ENDIF
  2384.       ELSE
  2385.         IF NOT three_d!
  2386.           PRINT AT(6,22);"Grid Intervals X axis, Y axis";
  2387.           PRINT AT(6,23);"X Axis=";
  2388.           FORM INPUT 5,temp$
  2389.           GOSUB clearit
  2390.           temp$=UPPER$(temp$)
  2391.           IF temp$="PI"
  2392.             x_int#=PI/4
  2393.             trig!=TRUE
  2394.           ELSE
  2395.             trig!=FALSE
  2396.             GOSUB dec_val
  2397.             IF d_val#<0.01
  2398.               d_val#=0.5
  2399.             ENDIF
  2400.             x_int#=d_val#
  2401.           ENDIF
  2402.           PRINT AT(6,23);"Y Axis=";
  2403.           FORM INPUT 5,temp$
  2404.           GOSUB clearit_all
  2405.           IF temp$<>""
  2406.             GOSUB dec_val
  2407.             IF d_val#<0.01
  2408.               d_val#=0.5
  2409.             ENDIF
  2410.             y_int#=d_val#
  2411.           ELSE
  2412.             y_int#=x_int#
  2413.           ENDIF
  2414.           '          Text 33*Rxf%,149*Ryf%,Space$(Sclear%)
  2415.           GOSUB lint
  2416.         ENDIF
  2417.       ENDIF
  2418.     ENDIF
  2419.   ENDIF
  2420. RETURN
  2421. PROCEDURE inp_error
  2422.   ' ----Input Error-------
  2423.   ' Most input errors are handled by the program but we make you redo these
  2424.   PRINT "◆";
  2425.   PRINT AT(6,22);"Hi value must be greater than lo"
  2426.   PAUSE 150
  2427.   GOSUB clearit_all
  2428. RETURN
  2429. PROCEDURE clearit
  2430.   ' Clear out the line
  2431.   PRINT AT(5,23);SPACE$(30)
  2432. RETURN
  2433. PROCEDURE clearit_all
  2434.   PRINT AT(5,22);SPACE$(sclear|)
  2435.   PRINT AT(5,23);SPACE$(sclear|)
  2436. RETURN
  2437. PROCEDURE dec_val
  2438.   ' dddddddddddddddddddddd-Input Decimal Values-ddddddddddddddddddd
  2439.   ' Convert the input string to a decimal value
  2440.   dcml#=INSTR(temp$,".",0)
  2441.   IF dcml#<>0
  2442.     d_digits#=LEN(temp$)-dcml#
  2443.     d_val#=ABS(VAL(LEFT$(temp$,dcml#-1)))+VAL(MID$(temp$,dcml#+1,d_digits#))/(10^d_digits#)
  2444.     IF VAL(temp$)<0
  2445.       d_val#=-d_val#
  2446.     ENDIF
  2447.   ELSE
  2448.     d_val#=VAL(temp$)
  2449.   ENDIF
  2450. RETURN
  2451. PROCEDURE nwfunction
  2452.   ' NNNNNNNNNNNNNNNNNNNNNNNNN- New Function-NNNNNNNNNNNNNNNNNNNNNNN
  2453.   HIDEM
  2454.   cf!=TRUE
  2455.   CLS
  2456.   PRINT ''"<Esc> to abort (before selecting)"
  2457.   PRINT ''"<F1> to enter your own function"
  2458.   i%=0
  2459.   PRINT
  2460.   REPEAT
  2461.     PRINT "(";CHR$(65+i%);") ";
  2462.     IF res|<>lo|
  2463.       PRINT function$(type|,i%)
  2464.     ELSE
  2465.       PRINT LEFT$(function$(type|,i%),34)
  2466.       IF LEN(function$(type|,i%))>34
  2467.         PRINT SPACE$(6);MID$(function$(type|,i%),35,LEN(function$(type|,i%)))
  2468.       ENDIF
  2469.     ENDIF
  2470.     INC i%
  2471.   UNTIL function$(type|,i%)=""
  2472.   maxequa%=i%
  2473. reinput:
  2474.   temp%=INP(2)
  2475.   temp%=ASC(UPPER$(CHR$(temp%)))
  2476.   IF temp%<>27 AND temp%<>187
  2477.     SUB temp%,65
  2478.     IF temp%>=0 AND temp%<=maxequa%
  2479.       equat%(type|)=temp%
  2480.       GOSUB constinpt
  2481.       GOSUB getconst
  2482.     ELSE
  2483.       GOTO reinput
  2484.     ENDIF
  2485.   ENDIF
  2486.   IF temp%=187
  2487.     custom_funct!(type|)=TRUE
  2488.   ELSE
  2489.     custom_funct!(type|)=FALSE
  2490.   ENDIF
  2491.   IF custom_funct!(type|)=TRUE
  2492.     CLS
  2493.   try_cf_again:
  2494.     GOSUB custom_funct
  2495.     IF cfunctlabel$(type|)=""
  2496.       custom_funct!(type|)=FALSE
  2497.       CLS
  2498.       GOTO escape
  2499.     ENDIF
  2500.     GOSUB convert
  2501.     IF syntax_error!=TRUE
  2502.       GOTO try_cf_again
  2503.     ENDIF
  2504.     CLS
  2505.   escape:
  2506.   ENDIF
  2507.   CLS
  2508.   SHOWM
  2509. RETURN
  2510. PROCEDURE constinpt
  2511.   n%(0)=0
  2512.   i%=1
  2513.   PRINT ''CHR$(10);
  2514.   IF res|<>lo|
  2515.     PRINT function$(type|,equat%(type|))
  2516.   ELSE
  2517.     PRINT LEFT$(function$(type|,equat%(type|)),34)
  2518.     IF LEN(function$(type|,equat%(type|)))>34
  2519.       PRINT SPACE$(4);MID$(function$(type|,equat%(type|)),35,LEN(function$(type|,equat%(type|))))
  2520.     ENDIF
  2521.   ENDIF
  2522.   GOSUB findn
  2523.   i_line%=CRSLIN+1
  2524.   REPEAT
  2525.     PRINT AT(2,i_line%);CHR$(64+i%);"=";
  2526.     FORM INPUT 4,temp$
  2527.     IF i%=1 AND temp$=""
  2528.       FOR k%=1 TO 5
  2529.         FOR j%=1 TO 10
  2530.           const#(k%,j%)=1
  2531.         NEXT j%
  2532.       NEXT k%
  2533.       n%(i%)=0
  2534.     ELSE
  2535.       PRINT AT(2,i_line%);"          "
  2536.       GOSUB dec_val
  2537.       const#(type|,i%)=d_val#
  2538.       INC i%
  2539.       GOSUB findn
  2540.     ENDIF
  2541.   UNTIL n%(i%)=0
  2542. RETURN
  2543. PROCEDURE findn
  2544.   n%(i%)=INSTR(function$(type|,equat%(type|)),CHR$(64+i%))
  2545. RETURN
  2546. PROCEDURE prntfunct
  2547.   functlabel$=""
  2548.   n%(0)=0
  2549.   i%=1
  2550.   GOSUB findn
  2551.   REPEAT
  2552.     functlabel$=functlabel$+MID$(function$(type|,equat%(type|)),n%(i%-1)+1,n%(i%)-n%(i%-1)-1)+STR$(const#(type|,i%))
  2553.     INC i%
  2554.     GOSUB findn
  2555.   UNTIL n%(i%)=0
  2556.   functlabel$=functlabel$+MID$(function$(type|,equat%(type|)),n%(i%-1)+1,LEN(function$(type|,equat%(type|)))-n%(i%-1)+1)
  2557. RETURN
  2558. PROCEDURE getconst
  2559.   a#=const#(type|,1)
  2560.   b#=const#(type|,2)
  2561.   c#=const#(type|,3)
  2562.   d#=const#(type|,4)
  2563.   e#=const#(type|,5)
  2564.   f#=const#(type|,6)
  2565.   g#=const#(type|,7)
  2566.   h#=const#(type|,8)
  2567.   i#=const#(type|,9)
  2568.   j#=const#(type|,10)
  2569. RETURN
  2570. PROCEDURE discont_funct
  2571.   ' ********************-Discontinuous Function-*******************
  2572.   ' Do this if function returns an error
  2573.   funct_error!=TRUE
  2574.   ON ERROR GOSUB discont_funct
  2575.   RESUME NEXT
  2576. RETURN
  2577. PROCEDURE fnd_cont_pnt(theta#,dtheta#)
  2578.   ' $$$$$$$$$$$$$$-Find the limit of a discontinuity-$$$$$$$$$$$$$$
  2579.   ' Finds the exact point where a function moves from a continuous area to
  2580.   ' discontinuos and back so there are no unnecessary gaps.  Only used by polar
  2581.   ' in this version. Sorry.
  2582.   REPEAT
  2583.     DIV dtheta#,2
  2584.     IF funct_error! !Did this point produce an error
  2585.       IF discont!=FALSE !Did we move from a continuous area to discontinuous
  2586.         SUB theta#,dtheta#
  2587.       ELSE ! Then we moved from a discontinuous to continuous area
  2588.         ADD theta#,dtheta#
  2589.       ENDIF
  2590.     ELSE !Must be a good point
  2591.       IF discont!=FALSE
  2592.         ADD theta#,dtheta#
  2593.       ELSE
  2594.         SUB theta#,dtheta#
  2595.       ENDIF
  2596.     ENDIF
  2597.     funct_error!=FALSE
  2598.     IF custom_funct!(type|)=TRUE
  2599.       var1#=theta#
  2600.       GOSUB evaluate
  2601.       IF NOT funct_error!
  2602.         r#=stack#(stack_ptr%)
  2603.       ENDIF
  2604.     ELSE
  2605.       ON equat%(type|)+1 GOSUB pol0,pol1,pol2,pol3,pol4,pol5,pol6,pol7,pol8,pol9,pol10,pol11,pol12,pol13,pol14,pol15
  2606.     ENDIF
  2607.   UNTIL dtheta#<1E-09 !Do it until the error is insignificant
  2608.   IF funct_error! !Did the last point produce an error
  2609.     IF discont!=FALSE !Then change theta by the small increment to move to
  2610.       ' the continuous area of the curve
  2611.       SUB theta#,dtheta#
  2612.     ELSE
  2613.       ADD theta#,dtheta#
  2614.     ENDIF
  2615.     IF custom_funct!(type|)=TRUE
  2616.       var1#=theta#
  2617.       GOSUB evaluate
  2618.       IF NOT funct_error!
  2619.         r#=stack#(stack_ptr%)
  2620.       ENDIF
  2621.     ELSE
  2622.       ON equat%(type|)+1 GOSUB pol0,pol1,pol2,pol3,pol4,pol5,pol6,pol7,pol8,pol9,pol10,pol11,pol12,pol13,pol14,pol15
  2623.     ENDIF
  2624.   ENDIF
  2625.   y#=r#*SIN(theta#)
  2626.   z#=r#*COS(theta#)
  2627.   px#(i%,j%)=0
  2628.   py#(i%,j%)=z# !Turn it sideways to be conventional
  2629.   pz#(i%,j%)=y#
  2630.   IF r#>max_limit#(type|) OR r#<min_limit#(type|)
  2631.     pz#(i%,j%)=funct_error%
  2632.   ENDIF
  2633. RETURN
  2634. PROCEDURE custom_funct
  2635.   ' UFUFUFUFUFUFUFUFUFUFUFUFUFUF-User entered function-UFUFUFUFUFUFUFUFUFUFUFUFUF
  2636.   ' --Get the function--
  2637.   HIDEM
  2638.   cf!=TRUE
  2639.   PRINT
  2640.   IF type|=sphere|
  2641.     PRINT "   ϕ=Control-s,m   Θ=Control-s,i"
  2642.   ENDIF
  2643.   IF type|=cylin|
  2644.     PRINT "   Θ=Control-s,i"
  2645.   ENDIF
  2646.   IF type|=polar|
  2647.     PRINT "   Θ=Control-s,i"
  2648.   ENDIF
  2649.   PRINT AT(4,4);"Enter your function:"
  2650.   IF type|=rect|
  2651.     temp$="z="
  2652.   ELSE
  2653.     IF type|=cart|
  2654.       temp$="y="
  2655.     ELSE
  2656.       temp$="r="
  2657.     ENDIF
  2658.   ENDIF
  2659.   PRINT AT(4,6);temp$;
  2660.   FORM INPUT 255 AS cfunctlabel$(type|)
  2661. RETURN
  2662. PROCEDURE convert
  2663.   ' --Convert user function to postfix mode--
  2664.   lparen%=0
  2665.   rparen%=0
  2666.   syntax_error!=FALSE
  2667.   infix$=UPPER$(cfunctlabel$(type|))
  2668.   IF type|<>rect| OR type|<>cart|
  2669.     FOR i%=1 TO LEN(infix$)
  2670.       in_str$=MID$(infix$,i%,1)
  2671.       IF in_str$="("
  2672.         INC lparen%
  2673.       ENDIF
  2674.       IF in_str$=")"
  2675.         INC rparen%
  2676.       ENDIF
  2677.       IF type|=sphere|
  2678.         IF in_str$="ϕ"
  2679.           MID$(infix$,i%,1)="X"
  2680.         ENDIF
  2681.         IF in_str$="Θ"
  2682.           MID$(infix$,i%,1)="Y"
  2683.         ENDIF
  2684.       ENDIF
  2685.       IF type|=cylin|
  2686.         IF in_str$="Θ"
  2687.           MID$(infix$,i%,1)="X"
  2688.         ENDIF
  2689.         IF in_str$="Z"
  2690.           MID$(infix$,i%,1)="Y"
  2691.         ENDIF
  2692.       ENDIF
  2693.       IF type|=polar|
  2694.         IF in_str$="Θ"
  2695.           MID$(infix$,i%,1)="X"
  2696.         ENDIF
  2697.       ENDIF
  2698.     NEXT i%
  2699.   ENDIF
  2700.   IF rparen%<>lparen%
  2701.     PRINT AT(4,8);"◆Unmatched Parenthesis"
  2702.     syntax_error!=TRUE
  2703.     GOTO convert_end
  2704.   ENDIF
  2705.   infix_ptr%=1
  2706.   postfix$(type|)=""
  2707.   stack$=""
  2708.   n%=0
  2709.   number%=1
  2710.   stack_priority%(0)=0
  2711.   WHILE infix_ptr%<=LEN(infix$)
  2712.     token$=""
  2713.     INC n%
  2714.     in_str$=MID$(infix$,infix_ptr%,1)
  2715.     IF (ASC(in_str$)>47 AND ASC(in_str$)<58) OR in_str$="." !numbers 0-9 or decimal
  2716.       token$="O"
  2717.       priority%(n%)=0
  2718.       digit_ptr%=infix_ptr%
  2719.       REPEAT
  2720.         INC infix_ptr%
  2721.         in_str$=MID$(infix$,infix_ptr%,1)
  2722.       UNTIL (ASC(in_str$)<48 OR ASC(in_str$)>57) AND in_str$<>"."
  2723.       digits%=infix_ptr%-digit_ptr%-1
  2724.       temp$=MID$(infix$,digit_ptr%,digits%+1)
  2725.       GOSUB dec_val
  2726.       numer_val#(number%)=d_val#
  2727.       INC number%
  2728.     ELSE
  2729.       IF ASC(in_str$)>64 AND ASC(in_str$)<91 !letters A-Z
  2730.         IF in_str$="X" OR in_str$="Y"
  2731.           token$=CHR$(ASC(in_str$)-8)
  2732.           priority%(n%)=0
  2733.           INC infix_ptr%
  2734.         ELSE
  2735.           funct$=MID$(infix$,infix_ptr%,4)
  2736.           IF funct$="SIN("
  2737.             token$="G"
  2738.             priority%(n%)=5
  2739.             infix_ptr%=infix_ptr%+3
  2740.           ENDIF
  2741.           IF funct$="COS("
  2742.             token$="H"
  2743.             priority%(n%)=5
  2744.             infix_ptr%=infix_ptr%+3
  2745.           ENDIF
  2746.           IF funct$="EXP("
  2747.             token$="I"
  2748.             priority%(n%)=5
  2749.             infix_ptr%=infix_ptr%+3
  2750.           ENDIF
  2751.           IF funct$="LOG("
  2752.             token$="J"
  2753.             priority%(n%)=5
  2754.             infix_ptr%=infix_ptr%+3
  2755.           ENDIF
  2756.           IF funct$="SQR("
  2757.             token$="K"
  2758.             priority%(n%)=5
  2759.             infix_ptr%=infix_ptr%+3
  2760.           ENDIF
  2761.           IF funct$="TAN("
  2762.             token$="L"
  2763.             priority%(n%)=5
  2764.             infix_ptr%=infix_ptr%+3
  2765.           ENDIF
  2766.           IF funct$="ABS("
  2767.             token$="M"
  2768.             priority%(n%)=5
  2769.             infix_ptr%=infix_ptr%+3
  2770.           ENDIF
  2771.           IF funct$="ATN("
  2772.             token$="N"
  2773.             priority%(n%)=5
  2774.             infix_ptr%=infix_ptr%+3
  2775.           ENDIF
  2776.         ENDIF
  2777.       ELSE
  2778.         IF in_str$="(" OR in_str$=")"
  2779.           token$=in_str$
  2780.           priority%(n%)=0
  2781.         ENDIF
  2782.         IF in_str$="+"
  2783.           token$="A"
  2784.           priority%(n%)=1
  2785.         ENDIF
  2786.         IF in_str$="-"
  2787.           IF MID$(infix$,infix_ptr%-1,1)="(" OR infix_ptr%=1
  2788.             priority%(n%)=3
  2789.             token$="B"
  2790.           ELSE
  2791.             priority%(n%)=1
  2792.             token$="C"
  2793.           ENDIF
  2794.         ENDIF
  2795.         IF in_str$="*"
  2796.           token$="D"
  2797.           priority%(n%)=2
  2798.         ENDIF
  2799.         IF in_str$="/"
  2800.           token$="E"
  2801.           priority%(n%)=2
  2802.         ENDIF
  2803.         IF in_str$="^"
  2804.           token$="F"
  2805.           priority%(n%)=4
  2806.         ENDIF
  2807.         INC infix_ptr%
  2808.       ENDIF
  2809.     ENDIF
  2810.     IF token$=""
  2811.       PRINT AT(4,8);"◆Syntax Error         "
  2812.       syntax_error!=TRUE
  2813.       GOTO convert_end
  2814.     ENDIF
  2815.     IF token$="O" OR token$="P" OR token$="Q"
  2816.       postfix$(type|)=postfix$(type|)+token$
  2817.     ELSE
  2818.       IF token$="("
  2819.         stack$=stack$+token$
  2820.         stack_priority%(LEN(stack$))=priority%(n%)
  2821.       ELSE
  2822.         IF token$=")"
  2823.           WHILE RIGHT$(stack$)<>"("
  2824.             temp$=RIGHT$(stack$)
  2825.             postfix$(type|)=postfix$(type|)+temp$
  2826.             stack$=LEFT$(stack$,LEN(stack$)-1)
  2827.           WEND
  2828.           stack$=LEFT$(stack$,LEN(stack$)-1)
  2829.         ELSE
  2830.           WHILE priority%(n%)<=stack_priority%(LEN(stack$))
  2831.             postfix$(type|)=postfix$(type|)+RIGHT$(stack$)
  2832.             stack$=LEFT$(stack$,LEN(stack$)-1)
  2833.           WEND
  2834.           stack$=stack$+token$
  2835.           stack_priority%(LEN(stack$))=priority%(n%)
  2836.         ENDIF
  2837.       ENDIF
  2838.     ENDIF
  2839.   WEND
  2840.   WHILE LEN(stack$)>0
  2841.     token$=RIGHT$(stack$)
  2842.     postfix$(type|)=postfix$(type|)+token$
  2843.     stack$=LEFT$(stack$,LEN(stack$)-1)
  2844.   WEND
  2845.   postfix_ptr%=VARPTR(postfix$(type|))
  2846.   FOR i%=0 TO LEN(postfix$(type|))-1
  2847.     POKE postfix_ptr%+i%,PEEK(postfix_ptr%+i%)-64
  2848.   NEXT i%
  2849. convert_end:
  2850. RETURN
  2851. PROCEDURE evaluate
  2852.   ' --Evaluate postfix function--
  2853.   postfix_ptr%=VARPTR(postfix$(type|))
  2854.   last_token%=postfix_ptr%+LEN(postfix$(type|))-1
  2855.   number%=0
  2856.   stack_ptr%=0
  2857.   REPEAT
  2858.     ON PEEK(postfix_ptr%) GOSUB a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q
  2859.     INC postfix_ptr%
  2860.   UNTIL postfix_ptr%>last_token%
  2861. RETURN
  2862. PROCEDURE a
  2863.   DEC stack_ptr%
  2864.   ADD stack#(stack_ptr%),stack#(stack_ptr%+1)
  2865. RETURN
  2866. PROCEDURE b
  2867.   stack#(stack_ptr%)=-(stack#(stack_ptr%))
  2868. RETURN
  2869. PROCEDURE c
  2870.   DEC stack_ptr%
  2871.   SUB stack#(stack_ptr%),stack#(stack_ptr%+1)
  2872. RETURN
  2873. PROCEDURE d
  2874.   DEC stack_ptr%
  2875.   MUL stack#(stack_ptr%),stack#(stack_ptr%+1)
  2876. RETURN
  2877. PROCEDURE e
  2878.   DEC stack_ptr%
  2879.   DIV stack#(stack_ptr%),stack#(stack_ptr%+1)
  2880. RETURN
  2881. PROCEDURE f
  2882.   DEC stack_ptr%
  2883.   stack#(stack_ptr%)=stack#(stack_ptr%)^stack#(stack_ptr%+1)
  2884. RETURN
  2885. PROCEDURE g
  2886.   stack#(stack_ptr%)=SIN(stack#(stack_ptr%))
  2887. RETURN
  2888. PROCEDURE h
  2889.   stack#(stack_ptr%)=COS(stack#(stack_ptr%))
  2890. RETURN
  2891. PROCEDURE i
  2892.   stack#(stack_ptr%)=EXP(stack#(stack_ptr%))
  2893. RETURN
  2894. PROCEDURE j
  2895.   stack#(stack_ptr%)=LOG(stack#(stack_ptr%))
  2896. RETURN
  2897. PROCEDURE k
  2898.   stack#(stack_ptr%)=SQR(stack#(stack_ptr%))
  2899. RETURN
  2900. PROCEDURE l
  2901.   stack#(stack_ptr%)=TAN(stack#(stack_ptr%))
  2902. RETURN
  2903. PROCEDURE m
  2904.   stack#(stack_ptr%)=ABS(stack#(stack_ptr%))
  2905. RETURN
  2906. PROCEDURE n
  2907.   stack#(stack_ptr%)=ATN(stack#(stack_ptr%))
  2908. RETURN
  2909. PROCEDURE o
  2910.   INC stack_ptr%
  2911.   INC number%
  2912.   stack#(stack_ptr%)=numer_val#(number%)
  2913. RETURN
  2914. PROCEDURE p
  2915.   INC stack_ptr%
  2916.   stack#(stack_ptr%)=var1#
  2917. RETURN
  2918. PROCEDURE q
  2919.   INC stack_ptr%
  2920.   stack#(stack_ptr%)=var2#
  2921. RETURN
  2922. PROCEDURE get_pattern
  2923.   MENU KILL
  2924.   MENU OFF
  2925.   ptrn|=0
  2926.   CLS
  2927.   temp$="Click on a fill pattern"
  2928.   TEXT rxf|*66,ryf|*7,temp$
  2929.   COLOR 1
  2930.   DEFFILL 2,2,1
  2931.   PRBOX rxf|*10,ryf|*10,rxf|*62,ryf|*95
  2932.   DEFFILL 2,2,2
  2933.   PRBOX rxf|*72,ryf|*10,rxf|*124,ryf|*95
  2934.   DEFFILL 2,2,3
  2935.   PRBOX rxf|*134,ryf|*10,rxf|*186,ryf|*95
  2936.   DEFFILL 2,2,4
  2937.   PRBOX rxf|*196,ryf|*10,rxf|*248,ryf|*95
  2938.   DEFFILL 2,2,5
  2939.   PRBOX rxf|*258,ryf|*10,rxf|*310,ryf|*95
  2940.   DEFFILL 2,2,6
  2941.   PRBOX rxf|*10,ryf|*105,rxf|*62,ryf|*190
  2942.   DEFFILL 2,2,7
  2943.   PRBOX rxf|*72,ryf|*105,rxf|*124,ryf|*190
  2944.   DEFFILL 2,2,8
  2945.   PRBOX rxf|*134,ryf|*105,rxf|*186,ryf|*190
  2946.   DEFFILL 2,2,15
  2947.   PRBOX rxf|*196,ryf|*105,rxf|*248,ryf|*190
  2948.   DEFFILL 2,0,0
  2949.   PRBOX rxf|*258,ryf|*105,rxf|*310,ryf|*190
  2950.   SHOWM
  2951.   DO
  2952.     dum%=MOUSEK
  2953.     IF dum%=1
  2954.       GOSUB pattern_value
  2955.     ENDIF
  2956.     EXIT IF dum%=1 AND ptrn|>0
  2957.   LOOP
  2958.   CLS
  2959.   PAUSE 10
  2960.   GOSUB param_menu
  2961. RETURN
  2962. PROCEDURE pattern_value
  2963.   ' Top row of boxes
  2964.   MOUSE micex&,micey&,dum%
  2965.   IF micey&>ryf|*11 AND micey&<ryf|*ryf|*95
  2966.     IF micex&>rxf|*10 AND micex&<rxf|*62
  2967.       ptrn|=1
  2968.     ENDIF
  2969.     IF micex&>rxf|*72 AND micex&<rxf|*124
  2970.       ptrn|=2
  2971.     ENDIF
  2972.     IF micex&>rxf|*134 AND micex&<rxf|*186
  2973.       ptrn|=3
  2974.     ENDIF
  2975.     IF micex&>rxf|*196 AND micex&<rxf|*248
  2976.       ptrn|=4
  2977.     ENDIF
  2978.     IF micex&>rxf|*258 AND micex&<rxf|*310
  2979.       ptrn|=5
  2980.     ENDIF
  2981.   ENDIF
  2982.   IF micey&>ryf|*105 AND micey&<ryf|*190
  2983.     IF micex&>rxf|*10 AND micex&<rxf|*62
  2984.       ptrn|=6
  2985.     ENDIF
  2986.     IF micex&>rxf|*72 AND micex&<rxf|*124
  2987.       ptrn|=7
  2988.     ENDIF
  2989.     IF micex&>rxf|*134 AND micex&<rxf|*186
  2990.       ptrn|=8
  2991.     ENDIF
  2992.     IF micex&>rxf|*196 AND micex&<rxf|*248
  2993.       ptrn|=15
  2994.     ENDIF
  2995.     IF micex&>rxf|*258 AND micex&<rxf|*310
  2996.       ptrn|=100
  2997.     ENDIF
  2998.   ENDIF
  2999. RETURN
  3000. PROCEDURE drw_grid
  3001.   IF demo|=on|
  3002.     IF yhi#-ylo#>7 OR zhi#-zlo#>5
  3003.       x_int#=1
  3004.       y_int#=1
  3005.     ELSE
  3006.       x_int#=0.5
  3007.       y_int#=0.5
  3008.     ENDIF
  3009.   ENDIF
  3010.   sx0#=-1
  3011.   sy0#=-1
  3012.   n%=0
  3013.   k%=0
  3014.   COLOR colrtable|(2)
  3015.   top_bottom!=TRUE
  3016.   qz1#=0
  3017.   GOSUB horiz_lines
  3018.   top_bottom!=FALSE
  3019.   GOSUB vert_lines
  3020.   GOSUB horiz_lines
  3021.   DEFTEXT colrtable|(1),0,0,4
  3022.   GOSUB horiz_line_lables
  3023.   DEFTEXT colrtable|(1),0,900,4
  3024.   GOSUB vert_line_lables
  3025. RETURN
  3026. PROCEDURE vert_lines
  3027.   qy1#=0
  3028.   qx#=0
  3029.   qz#=0
  3030.   qy#=qy1#
  3031.   GOSUB calcsxsy
  3032.   sx1#=sx#
  3033.   SUB qy1#,x_int#
  3034.   DEC n%
  3035.   qx#=0
  3036.   qz#=0
  3037.   qy#=qy1#
  3038.   GOSUB calcsxsy
  3039.   sx_int#=ABS(sx1#-sx#)
  3040.   REPEAT
  3041.     DEC n%
  3042.     SUB sx#,sx_int#
  3043.     SUB qy1#,x_int#
  3044.   UNTIL sx#<0
  3045.   first!=FALSE
  3046.   y%(0)=top%
  3047.   y%(1)=bottom%
  3048.   REPEAT
  3049.     IF qy1#>-0.1*x_int# AND qy1#<0.1*x_int#
  3050.       COLOR colrtable|(2)
  3051.       sx0#=sx#
  3052.     ELSE
  3053.       COLOR colrtable|(3)
  3054.     ENDIF
  3055.     IF sx#>0 AND sx#<max_sx&
  3056.       IF first!=FALSE
  3057.         left%=sx#
  3058.         first!=TRUE
  3059.       ENDIF
  3060.       x%(0)=sx#
  3061.       x%(1)=sx#
  3062.       right%=sx#
  3063.       POLYLINE 2,x%(),y%()
  3064.       IF n%<>0
  3065.       ENDIF
  3066.     ENDIF
  3067.     ADD qy1#,x_int#
  3068.     ADD sx#,sx_int#
  3069.     INC n%
  3070.   UNTIL sx#>max_sx&
  3071.   ' save last sx for lables
  3072.   sx1#=sx#
  3073. RETURN
  3074. PROCEDURE horiz_lines
  3075.   qz1#=0
  3076.   qx#=0
  3077.   qy#=0
  3078.   qz#=qz1#
  3079.   GOSUB calcsxsy
  3080.   sy1#=sy#
  3081.   SUB qz1#,y_int#
  3082.   DEC k%
  3083.   qx#=0
  3084.   qy#=0
  3085.   qz#=qz1#
  3086.   GOSUB calcsxsy
  3087.   sy_int#=ABS(sy1#-sy#)
  3088.   REPEAT
  3089.     DEC k%
  3090.     ADD sy#,sy_int#
  3091.     SUB qz1#,y_int#
  3092.   UNTIL sy#>max_sy&
  3093.   first!=FALSE
  3094.   x%(0)=left%
  3095.   x%(1)=right%
  3096.   REPEAT
  3097.     IF qz1#>-0.1*y_int# AND qz1#<0.1*y_int#
  3098.       sy0#=sy#
  3099.       COLOR colrtable|(2)
  3100.     ELSE
  3101.       COLOR colrtable|(3)
  3102.     ENDIF
  3103.     IF sy#<max_sy& AND sy#>0
  3104.       IF first!=FALSE
  3105.         bottom%=sy#
  3106.         first!=TRUE
  3107.       ENDIF
  3108.       y%(0)=sy#
  3109.       y%(1)=sy#
  3110.       top%=sy#
  3111.       IF top_bottom!=FALSE
  3112.         POLYLINE 2,x%(),y%()
  3113.       ENDIF
  3114.     ENDIF
  3115.     INC k%
  3116.     ADD qz1#,y_int#
  3117.     SUB sy#,sy_int#
  3118.   UNTIL sy#<0
  3119. RETURN
  3120. PROCEDURE horiz_line_lables
  3121.   REPEAT
  3122.     ADD sy#,sy_int#
  3123.     SUB qz1#,y_int#
  3124.     IF sx0#>-1 AND sx0#<max_sx&
  3125.       TEXT sx0#+2,sy#,STR$(qz1#)
  3126.     ELSE
  3127.       TEXT left%,sy#,STR$(qz1#)
  3128.     ENDIF
  3129.   UNTIL sy#+1>bottom%
  3130. RETURN
  3131. PROCEDURE vert_line_lables
  3132.   sx#=sx1#
  3133.   REPEAT
  3134.     DEC n%
  3135.     SUB sx#,sx_int#
  3136.     SUB qy1#,x_int#
  3137.     IF (NOT sx#==sx0#)
  3138.       IF trig!=FALSE
  3139.         IF sy0#>-1 AND sy0#<max_sy&
  3140.           TEXT sx#,sy0#-2,STR$(qy1#)
  3141.         ELSE
  3142.           TEXT sx#,bottom%,STR$(qy1#)
  3143.         ENDIF
  3144.       ELSE
  3145.         GOSUB trig_labels
  3146.       ENDIF
  3147.     ENDIF
  3148.   UNTIL sx#-1<left%
  3149. RETURN
  3150. PROCEDURE trig_labels
  3151.   ' π=Control s,c
  3152.   IF EVEN(n%)=TRUE
  3153.     IF EVEN(n%/2)
  3154.       temp$=STR$(n%/4)+"π"
  3155.     ELSE
  3156.       temp$=STR$(n%/2)+"π/2"
  3157.     ENDIF
  3158.     IF n%=2
  3159.       temp$="π/2"
  3160.     ENDIF
  3161.     IF n%=4
  3162.       temp$="π"
  3163.     ENDIF
  3164.     IF n%=-2
  3165.       temp$="-π/2"
  3166.     ENDIF
  3167.     IF n%=-4
  3168.       temp$="-π"
  3169.     ENDIF
  3170.     IF sy0#>-1 AND sy0#<max_sy&
  3171.       TEXT sx#,sy0#-2,temp$
  3172.     ELSE
  3173.       TEXT sx#,bottom%,temp$
  3174.     ENDIF
  3175.   ENDIF
  3176. RETURN
  3177. PROCEDURE cad3d_save
  3178.   ' c3dc3dc3dc3dc3dc3dc3dc3dc3d-CAD3D SAVE-c3dc3dc3dc3dc3dc3dc3dc3d
  3179.   scale_factor#=15/MAX(xhi#,ABS(xlo#),yhi#,ABS(ylo#),zhi#,ABS(zlo#)) !scale factor to make objects a good size
  3180.   MUL scale_factor#,100
  3181.   RESTORE caddat
  3182.   pnt_no%=0
  3183.   cad3d_dat$=STRING$(8033," ") !create a buffer
  3184.   strpntr%=VARPTR(cad3d_dat$) !pointer to buffer
  3185.   ' read light and color data
  3186.   FOR i%=0 TO 51
  3187.     READ j%
  3188.     DPOKE strpntr%,j%
  3189.     ADD strpntr%,2
  3190.   NEXT i%
  3191.   ' fill in empty space with zeros
  3192.   REPEAT
  3193.     DPOKE strpntr%,0
  3194.     ADD strpntr%,2
  3195.   UNTIL strpntr%=VARPTR(cad3d_dat$)+258
  3196.   ' insert object name
  3197.   MID$(cad3d_dat$,257,9)=o_name$
  3198.   BPUT #1,VARPTR(cad3d_dat$),265
  3199.   ' remember this spot in file to put the vertice count
  3200.   f_pointer%=LOC(#1)
  3201.   strpntr%=VARPTR(cad3d_dat$)+2 !leave space for vcount
  3202.   buffer%=2
  3203.   FOR i%=0 TO pntint_x%(type|)
  3204.     FOR j%=0 TO pntint_y%(type|)
  3205.       pnt_repeat!=FALSE
  3206.       first_to_last!=FALSE
  3207.       IF pz#(i%,j%)<>funct_error%! check for function error and leave those points out
  3208.         k%=TRUNC((px#(i%,j%)-fx#)*scale_factor#)
  3209.         l%=TRUNC((py#(i%,j%)-fy#)*scale_factor#)
  3210.         m%=TRUNC((pz#(i%,j%)-fz#)*scale_factor#)
  3211.         IF j%<>0
  3212.           ' if this point is the same as the last one set a flag
  3213.           IF k%=TRUNC(px#(i%,j%-1)*scale_factor#) AND l%=TRUNC(py#(i%,j%-1)*scale_factor#) AND m%=TRUNC(pz#(i%,j%-1)*scale_factor#)
  3214.             pnt_repeat!=TRUE
  3215.           ENDIF
  3216.           ' if the end point of this line is the same as the last point set a flag
  3217.           IF j%=pntint_y%(type|) AND (k%=TRUNC(px#(i%,0)*scale_factor#) AND l%=TRUNC(py#(i%,0)*scale_factor#) AND m%=TRUNC(pz#(i%,0)*scale_factor#))
  3218.             first_to_last!=TRUE
  3219.           ENDIF
  3220.         ENDIF
  3221.         ' if neither flag set, include the point
  3222.         IF pnt_repeat!=FALSE AND first_to_last!=FALSE
  3223.           pnt_no%(i%*(pntint_y%(type|)+1)+j%)=pnt_no%
  3224.           DPOKE strpntr%,k%
  3225.           ADD strpntr%,2
  3226.           DPOKE strpntr%,l%
  3227.           ADD strpntr%,2
  3228.           DPOKE strpntr%,m%
  3229.           ADD strpntr%,2
  3230.           ADD buffer%,6
  3231.           IF buffer%>8000
  3232.             BPUT #1,VARPTR(cad3d_dat$),buffer%
  3233.             strpntr%=VARPTR(cad3d_dat$)
  3234.             buffer%=0
  3235.           ENDIF
  3236.           INC pnt_no% ! increase point number since this is a new point
  3237.         ENDIF
  3238.         IF first_to_last!
  3239.           ' make last point in this line same as first in the line
  3240.           pnt_no%(i%*(pntint_y%(type|)+1)+j%)=pnt_no%(i%*(pntint_y%(type|)+1))
  3241.         ELSE
  3242.           ' record the point number
  3243.           pnt_no%(i%*(pntint_y%(type|)+1)+j%)=pnt_no%-1
  3244.         ENDIF
  3245.       ENDIF
  3246.     NEXT j%
  3247.   NEXT i%
  3248.   BPUT #1,VARPTR(cad3d_dat$),buffer% !empty the buffer
  3249.   vcount%=pnt_no%
  3250.   f_pointer1%=LOC(#1) !remember where we were in the file
  3251.   DPOKE VARPTR(cad3d_dat$),vcount%
  3252.   SEEK #1,f_pointer% !go back in the file and record vcount
  3253.   BPUT #1,VARPTR(cad3d_dat$),2
  3254.   SEEK #1,f_pointer1% !reset file pointer
  3255.   strpntr%=VARPTR(cad3d_dat$)
  3256.   buffer%=0
  3257.   f_pointer%=LOC(#1) !remember this spot for face count
  3258.   ADD strpntr%,2
  3259.   ADD buffer%,2 !leave room for face count
  3260.   face_count%=0
  3261.   FOR i%=0 TO pntint_x%(type|)-1
  3262.     FOR j%=0 TO pntint_y%(type|)-1
  3263.       IF pz#(i%,j%)<>funct_error% AND pz#(i%,j%+1)<>funct_error% AND pz#(i%+1,j%)<>funct_error% AND pz#(i%+1,j%+1)<>funct_error%
  3264.         k%=i%*(pntint_y%(type|)+1)+j%
  3265.         l%=k%+1
  3266.         m%=l%+pntint_y%(type|)
  3267.         n%=m%+1
  3268.         IF side1!
  3269.           GOSUB side1
  3270.         ENDIF
  3271.         IF side2!
  3272.           GOSUB side2
  3273.         ENDIF
  3274.       ENDIF
  3275.       IF buffer%>8000
  3276.         BPUT #1,VARPTR(cad3d_dat$),buffer%
  3277.         strpntr%=VARPTR(cad3d_dat$)
  3278.         buffer%=0
  3279.       ENDIF
  3280.     NEXT j%
  3281.   NEXT i%
  3282.   BPUT #1,VARPTR(cad3d_dat$),buffer%
  3283.   DPOKE VARPTR(cad3d_dat$),face_count%
  3284.   SEEK #1,f_pointer% !go back and record the face count
  3285.   BPUT #1,VARPTR(cad3d_dat$),2
  3286.   CLOSE #1
  3287. caddat:
  3288.   DATA &3D02,&0001,&0001,&0000,&0000,&0007,&0004,&0003,&0000,&0040,&FFCE,&0000,&0004,&0032,&FFCE,&003D,&FFCE
  3289.   DATA &0000,&0000,&0101,&0202,&0303,&0404,&0505,&0606,&0707,&0717,&0727,&0737,&0747,&0757,&0767,&0777,&0777
  3290.   DATA &0000,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&0001,&000F,&0001,&000F
  3291. RETURN
  3292. PROCEDURE side1
  3293.   ' check to see if all four points are different
  3294.   IF pnt_no%(k%)<>pnt_no%(l%) AND pnt_no%(m%)<>pnt_no%(n%)
  3295.   front: !front side
  3296.   begindoub:
  3297.     DPOKE strpntr%,pnt_no%(k%)
  3298.     ADD strpntr%,2
  3299.     DPOKE strpntr%,pnt_no%(l%)
  3300.     ADD strpntr%,2
  3301.     DPOKE strpntr%,pnt_no%(n%)
  3302.     ADD strpntr%,2
  3303.     DPOKE strpntr%,&H608
  3304.     ADD strpntr%,2
  3305.     DPOKE strpntr%,pnt_no%(k%)
  3306.     ADD strpntr%,2
  3307.     DPOKE strpntr%,pnt_no%(n%)
  3308.     ADD strpntr%,2
  3309.     DPOKE strpntr%,pnt_no%(m%)
  3310.     ADD strpntr%,2
  3311.     DPOKE strpntr%,&H308
  3312.     ADD strpntr%,2
  3313.     ADD face_count%,2
  3314.     ADD buffer%,16
  3315.   enddoub:
  3316.   ELSE !if two points are the same make it just a triangle
  3317.   begdoub1:
  3318.     IF pnt_no%(m%)=pnt_no%(n%)
  3319.       DPOKE strpntr%,pnt_no%(k%)
  3320.       ADD strpntr%,2
  3321.       DPOKE strpntr%,pnt_no%(l%)
  3322.       ADD strpntr%,2
  3323.       DPOKE strpntr%,pnt_no%(n%)
  3324.       ADD strpntr%,2
  3325.       DPOKE strpntr%,&H708
  3326.       ADD strpntr%,2
  3327.     ELSE
  3328.       DPOKE strpntr%,pnt_no%(k%)
  3329.       ADD strpntr%,2
  3330.       DPOKE strpntr%,pnt_no%(n%)
  3331.       ADD strpntr%,2
  3332.       DPOKE strpntr%,pnt_no%(m%)
  3333.       ADD strpntr%,2
  3334.       DPOKE strpntr%,&H708
  3335.       ADD strpntr%,2
  3336.     ENDIF
  3337.   enddoub1:
  3338.     INC face_count%
  3339.     ADD buffer%,8
  3340.   ENDIF
  3341. RETURN
  3342. PROCEDURE side2
  3343.   IF pnt_no%(k%)<>pnt_no%(l%) AND pnt_no%(m%)<>pnt_no%(n%)
  3344.     DPOKE strpntr%,pnt_no%(k%)
  3345.     ADD strpntr%,2
  3346.     DPOKE strpntr%,pnt_no%(m%)
  3347.     ADD strpntr%,2
  3348.     DPOKE strpntr%,pnt_no%(n%)
  3349.     ADD strpntr%,2
  3350.     DPOKE strpntr%,&H608
  3351.     ADD strpntr%,2
  3352.     DPOKE strpntr%,pnt_no%(k%)
  3353.     ADD strpntr%,2
  3354.     DPOKE strpntr%,pnt_no%(n%)
  3355.     ADD strpntr%,2
  3356.     DPOKE strpntr%,pnt_no%(l%)
  3357.     ADD strpntr%,2
  3358.     DPOKE strpntr%,&H308
  3359.     ADD strpntr%,2
  3360.     ADD face_count%,2
  3361.     ADD buffer%,16
  3362.   ELSE !if two points are the same make it just a triangle
  3363.     IF pnt_no%(k%)=pnt_no%(l%)
  3364.     front1:
  3365.       DPOKE strpntr%,pnt_no%(k%)
  3366.       ADD strpntr%,2
  3367.       DPOKE strpntr%,pnt_no%(m%)
  3368.       ADD strpntr%,2
  3369.       DPOKE strpntr%,pnt_no%(n%)
  3370.       ADD strpntr%,2
  3371.       DPOKE strpntr%,&H708
  3372.       ADD strpntr%,2
  3373.     ELSE
  3374.       DPOKE strpntr%,pnt_no%(k%)
  3375.       ADD strpntr%,2
  3376.       DPOKE strpntr%,pnt_no%(n%)
  3377.       ADD strpntr%,2
  3378.       DPOKE strpntr%,pnt_no%(l%)
  3379.       ADD strpntr%,2
  3380.       DPOKE strpntr%,&H708
  3381.       ADD strpntr%,2
  3382.     ENDIF
  3383.     INC face_count%
  3384.     ADD buffer%,8
  3385.   ENDIF
  3386. RETURN
  3387. PROCEDURE rec0
  3388.   ' RFRFRFRFRFRFRFRFRF-Rectangular Functions-RFRFRFRFRFRFRFRFRFRFRF
  3389.   '  Rectangular
  3390.   z#=(a#*x#*x#+b#*y#*y#)*EXP(1-c#*x#*x#-d#*y#*y#)
  3391. RETURN
  3392. PROCEDURE rec1
  3393.   z#=a#/SQR(b#+x#*x#+y#*y#)*COS(SQR(c#*y#*y#+d#*x#*x#))
  3394. RETURN
  3395. PROCEDURE rec2
  3396.   z#=(a#*x#*y#)^(1/b#)
  3397. RETURN
  3398. PROCEDURE rec3
  3399.   z#=a#*SIN(b#*x#)+c#*COS(d#*y#)
  3400. RETURN
  3401. PROCEDURE rec4
  3402.   z#=a#*COS(b#*x#*c#*y#)
  3403. RETURN
  3404. PROCEDURE rec5
  3405.   z#=a#*(EXP(b#*SIN(c#*x#*d#*y#)))
  3406. RETURN
  3407. PROCEDURE rec6
  3408.   z#=a#*(ABS(b#*COS(c#*x#)+d#*COS(e#*y#)))
  3409. RETURN
  3410. PROCEDURE rec7
  3411.   z#=a#*(SQR(b#*x#^c#+d#*y#^e#))
  3412. RETURN
  3413. PROCEDURE rec8
  3414.   z#=1/(a#+x#*x#+y#*y#)-1/(b#+x#*x#+(y#-2)*(y#-2))
  3415. RETURN
  3416. PROCEDURE rec9
  3417.   z#=(x#*x#*COS(a#*x#)+y#*y#*b#*SIN(c#*y#))*EXP(1-x#*x#-y#*y#)
  3418. RETURN
  3419. PROCEDURE rec10
  3420.   z#=a#*LOG(ABS(b#*x#))+c#*LOG(ABS(d#*y#))
  3421. RETURN
  3422. PROCEDURE rec11
  3423.   z#=SIN(a#*x#)*COS(b#*y#)
  3424. RETURN
  3425. PROCEDURE rec12
  3426.   z#=a#*COS(SQR(b#*x#*x#+c#*y#*y#))+d#*COS(x#)
  3427. RETURN
  3428. PROCEDURE sph0
  3429.   ' SFSFSFSFSFSFSFSFSF-Spherical Functions-SFSFSFSFSFSFSFSFSFSFSFSF
  3430.   r#=a#+b#*SQR(c#*COS(d#*phi#))
  3431. RETURN
  3432. PROCEDURE sph1
  3433.   r#=a#+b#*SIN(c#*phi#/d#)
  3434. RETURN
  3435. PROCEDURE sph2
  3436.   r#=a#+b#*SQR(c#*phi#)
  3437. RETURN
  3438. PROCEDURE sph3
  3439.   r#=a#+b#/COS(phi#)
  3440. RETURN
  3441. PROCEDURE sph4
  3442.   r#=a#+b#*SIN(c#*theta#)
  3443. RETURN
  3444. PROCEDURE sph5
  3445.   r#=a#*SIN(b#*phi#)+c#*COS(d#*theta#)
  3446. RETURN
  3447. PROCEDURE sph6
  3448.   r#=a#*SIN(b#*phi#)/(c#*COS(phi#)+1)
  3449. RETURN
  3450. PROCEDURE sph7
  3451.   r#=a#*SIN(b#*phi#)+c#*COS(d#*phi#)+e#
  3452. RETURN
  3453. PROCEDURE sph8
  3454.   r#=a#/(b#-c#*COS(d#*(phi#)))+e#
  3455. RETURN
  3456. PROCEDURE sph9
  3457.   r#=a#/(b#-c#*SIN(d#*(phi#)))+e#
  3458. RETURN
  3459. PROCEDURE sph10
  3460.   r#=a#*SIN(b#*theta#)+c#*COS(d#*phi#)
  3461. RETURN
  3462. PROCEDURE sph11
  3463.   r#=a#*SIN(EXP(phi#))+b#*COS(EXP(phi#))
  3464. RETURN
  3465. PROCEDURE sph12
  3466.   r#=a#*phi#+b#*theta#
  3467. RETURN
  3468. PROCEDURE cyl0
  3469.   ' CFCFCFCFCFCFCFCFCF-Cylindrical Functions-CFCFCFCFCFCFCFCFCFCFCF
  3470.   r#=a#+b#*COS(c#*theta#)+d#*SIN(e#*theta#)
  3471. RETURN
  3472. PROCEDURE cyl1
  3473.   r#=a#/(b#-c#*COS(d#*theta#))+e#
  3474. RETURN
  3475. PROCEDURE cyl2
  3476.   r#=a#*SIN(b#*theta#)+c#*COS(d#*theta#)+e#*z#
  3477. RETURN
  3478. PROCEDURE cyl3
  3479.   r#=a#+b#*SIN(c#*theta#)*COS(d#*theta#)
  3480. RETURN
  3481. PROCEDURE cyl4
  3482.   r#=a#+b#*TAN(c#*theta#)
  3483. RETURN
  3484. PROCEDURE cyl5
  3485.   r#=a#+b#*SIN(c#*theta#)*COS(d#*theta#)*COS(d#*theta#)
  3486. RETURN
  3487. PROCEDURE cyl6
  3488.   r#=a#+b#*z#-c#*SIN(d#*z#)
  3489. RETURN
  3490. PROCEDURE cyl7
  3491.   r#=a#*z#*z#+b#*z#+c#
  3492. RETURN
  3493. PROCEDURE cyl8
  3494.   r#=a#/z#*z#+b#/z#+c#
  3495. RETURN
  3496. PROCEDURE cyl9
  3497.   r#=a#+b#*z#+c#*z#*COS(d#*theta#)
  3498. RETURN
  3499. PROCEDURE cyl10
  3500.   r#=SIN(a#*z#)*COS(b#*theta#)
  3501. RETURN
  3502. PROCEDURE car0
  3503.   ' cfcfcfcfcfcfcfcfcfcfcf-Cartesian Functions-cfcfcfcfcfcfcfcfcfcf
  3504.   y#=a#*x#*x#*x#+b#*x#*x#+c#*x#+d#
  3505. RETURN
  3506. PROCEDURE car1
  3507.   y#=(a#/SQR(2*PI))*EXP(-x#*x#/2)
  3508. RETURN
  3509. PROCEDURE car2
  3510.   y#=x#/a#+x#^b#-x#^c#
  3511. RETURN
  3512. PROCEDURE car3
  3513.   y#=a#+b#*SIN(c#*x#)+d#*x#*(SIN(e#*x#))
  3514. RETURN
  3515. PROCEDURE car4
  3516.   y#=a#+b#*COS(c#*x#)+d#*x#*(COS(e#*x#))
  3517. RETURN
  3518. PROCEDURE car5
  3519.   y#=a#+b#*TAN(c#*x#)+d#*x#*(TAN(e#*x#))
  3520. RETURN
  3521. PROCEDURE car6
  3522.   y#=a#+b#*1/COS(c#*x#)+d#*x#*1/COS(e#*x#)
  3523. RETURN
  3524. PROCEDURE car7
  3525.   y#=a#+b#*SIN(c#*x#)+d#*x#*(COS(e#*x#))
  3526. RETURN
  3527. PROCEDURE car8
  3528.   y#=a#+b#*(EXP(x#)-EXP(-x#))/2+c#*(EXP(x#)+EXP(-x#))/2
  3529. RETURN
  3530. PROCEDURE car9
  3531.   y#=a#*SQR(b#*b#-x#*x#)
  3532. RETURN
  3533. PROCEDURE car10
  3534.   y#=(a#*x#-2)^3/(b#*x#*x#)
  3535. RETURN
  3536. PROCEDURE car11
  3537.   y#=a#*x#*x#/EXP(b#*x#)
  3538. RETURN
  3539. PROCEDURE car12
  3540.   y#=COS(a#*x#)*EXP(x#/b#)
  3541. RETURN
  3542. PROCEDURE car13
  3543.   y#=a#*x#*x#*x#*EXP(-x#/b#)
  3544. RETURN
  3545. PROCEDURE car14
  3546.   y#=a#*x#/((b#*x#+c#)*(b#*x#+c#))
  3547. RETURN
  3548. PROCEDURE car15
  3549.   y#=a#*ATN(x#)
  3550. RETURN
  3551. PROCEDURE pol0
  3552.   ' PFPFPFPFPFPFPFPFPFPFPFPF-Polar Functions-PFPFPFPFPFPFPFPFPFPFPF
  3553.   r#=a#+b#*COS(c#*theta#)+d#*SIN(e#*theta#)
  3554. RETURN
  3555. PROCEDURE pol1
  3556.   r#=a#+b#*SQR(c#*COS(d#*theta#))
  3557. RETURN
  3558. PROCEDURE pol2
  3559.   r#=a#/(b#-c#*COS(d#*theta#))+e#
  3560. RETURN
  3561. PROCEDURE pol3
  3562.   r#=a#/(b#-c#*SIN(d#*theta#))+e#
  3563. RETURN
  3564. PROCEDURE pol4
  3565.   r#=a#+b#*TAN(c#*theta#)
  3566. RETURN
  3567. PROCEDURE pol5
  3568.   r#=a#+b#*SIN(c#*theta#)*TAN(d#*theta#)
  3569. RETURN
  3570. PROCEDURE pol6
  3571.   r#=a#/theta#
  3572. RETURN
  3573. PROCEDURE pol7
  3574.   r#=a#+b#*SIN(c#*theta#)*COS(d#*theta#)
  3575. RETURN
  3576. PROCEDURE pol8
  3577.   r#=a#+b#/SIN(c#*theta#)
  3578. RETURN
  3579. PROCEDURE pol9
  3580.   r#=a#+b#*SIN(c#*theta#)*COS(d#*theta#)*COS(d#*theta#)
  3581. RETURN
  3582.